Theory Function_Ring
theory Function_Ring
imports "HOL-Algebra.Ring" "HOL-Library.FuncSet" "HOL-Algebra.Module"
begin
text‹
This theory formalizes basic facts about the ring of extensional functions from a fixed set to
a fixed ring. This will be useful for providing a generic framework for various constructions
related to the $p$-adics such as polynomial evaluation and sequences. The rings of semialgebraic
functions will be defined as subrings of these function rings, which will be necessary for the
proof of $p$-adic quantifier elimination.
›
section‹The Ring of Extensional Functions from a Fixed Base Set to a Fixed Base Ring›
subsection‹Basic Operations on Extensional Functions›
definition function_mult:: "'c set ⇒ ('a, 'b) ring_scheme ⇒ ('c ⇒ 'a) ⇒ ('c ⇒ 'a) ⇒ ('c ⇒ 'a)" where
"function_mult S R f g = (λx ∈ S. (f x) ⊗⇘R⇙ (g x))"
abbreviation(input) ring_function_mult:: "('a, 'b) ring_scheme ⇒ ('a ⇒ 'a) ⇒ ('a ⇒ 'a) ⇒ ('a ⇒ 'a)" where
"ring_function_mult R f g ≡ function_mult (carrier R) R f g"
definition function_add:: "'c set ⇒ ('a, 'b) ring_scheme ⇒ ('c ⇒ 'a) ⇒ ('c ⇒ 'a) ⇒ ('c ⇒ 'a)" where
"function_add S R f g = (λx ∈ S. (f x) ⊕⇘R⇙ (g x))"
abbreviation(input) ring_function_add:: "('a, 'b) ring_scheme ⇒ ('a ⇒ 'a) ⇒ ('a ⇒ 'a) ⇒ ('a ⇒ 'a)" where
"ring_function_add R f g ≡ function_add (carrier R) R f g"
definition function_one:: "'c set ⇒ ('a, 'b) ring_scheme ⇒ ('c ⇒ 'a)" where
"function_one S R = (λx ∈ S. 𝟭⇘R⇙)"
abbreviation(input) ring_function_one :: "('a, 'b) ring_scheme ⇒ ('a ⇒ 'a)" where
"ring_function_one R ≡ function_one (carrier R) R"
definition function_zero:: "'c set ⇒ ('a, 'b) ring_scheme ⇒ ('c ⇒ 'a)" where
"function_zero S R = (λx ∈ S. 𝟬⇘R⇙)"
abbreviation(input) ring_function_zero :: "('a, 'b) ring_scheme ⇒ ('a ⇒ 'a)" where
"ring_function_zero R ≡ function_zero (carrier R) R"
definition function_uminus:: "'c set ⇒ ('a, 'b) ring_scheme ⇒ ('c ⇒ 'a) ⇒ ('c ⇒ 'a)" where
"function_uminus S R a = (λ x ∈ S. ⊖⇘R⇙ (a x))"
definition ring_function_uminus:: " ('a, 'b) ring_scheme ⇒ ('a ⇒ 'a) ⇒ ('a ⇒ 'a)" where
"ring_function_uminus R a = function_uminus (carrier R) R a"
definition function_scalar_mult:: "'c set ⇒ ('a, 'b) ring_scheme ⇒ 'a ⇒ ('c ⇒ 'a) ⇒ ('c ⇒ 'a)" where
"function_scalar_mult S R a f = (λ x ∈ S. a ⊗⇘R⇙ (f x))"
subsection‹Defining the Ring of Extensional Functions›
definition function_ring:: "'c set ⇒ ('a, 'b) ring_scheme ⇒ ( 'a, 'c ⇒ 'a) module" where
"function_ring S R = ⦇
carrier = extensional_funcset S (carrier R),
Group.monoid.mult = (function_mult S R),
one = (function_one S R),
zero = (function_zero S R),
add = (function_add S R),
smult = function_scalar_mult S R ⦈ "
text‹The following locale consists of a struct R, and a distinguished set S which is meant to serve as the domain for a ring of functions $S \to carrier R$. ›
locale struct_functions =
fixes R ::"('a, 'b) partial_object_scheme" (structure)
and S :: "'c set"
text‹The following are locales which fix a ring R (which may be commutative, a domain, or a field) and a function ring F of extensional functions from a fixed set S to $carrier R$›
locale ring_functions = struct_functions + R?: ring R +
fixes F (structure)
defines F_def: "F ≡ function_ring S R"
locale cring_functions = ring_functions + R?: cring R
locale domain_functions = ring_functions + R?: domain R
locale field_functions = ring_functions + R?: field R
sublocale cring_functions < ring_functions
apply (simp add: ring_functions_axioms)
by (simp add: F_def)
sublocale domain_functions < ring_functions
apply (simp add: ring_functions_axioms)
by (simp add: F_def)
sublocale domain_functions < cring_functions
apply (simp add: cring_functions_def is_cring ring_functions_axioms)
by (simp add: F_def)
sublocale field_functions < domain_functions
apply (simp add: domain_axioms domain_functions_def ring_functions_axioms)
by (simp add: F_def)
sublocale field_functions < ring_functions
apply (simp add: ring_functions_axioms)
by (simp add: F_def)
sublocale field_functions < cring_functions
apply (simp add: cring_functions_axioms)
by (simp add: F_def)
abbreviation(input) ring_function_ring:: "('a, 'b) ring_scheme ⇒ ('a, 'a ⇒ 'a) module" ("Fun") where
"ring_function_ring R ≡ function_ring (carrier R) R"
subsection‹Algebraic Properties of the Basic Operations›
subsubsection‹Basic Carrier Facts›
lemma(in ring_functions) function_ring_defs:
"carrier F = extensional_funcset S (carrier R)"
"(⊗⇘F⇙) = (function_mult S R)"
"(⊕⇘F⇙) = (function_add S R)"
"𝟭⇘F⇙ = function_one S R"
"𝟬⇘F⇙ = function_zero S R"
"(⊙⇘F⇙) = function_scalar_mult S R"
unfolding F_def
by ( auto simp add: function_ring_def)
lemma(in ring_functions) function_ring_car_memE:
assumes "a ∈ carrier F"
shows "a ∈ extensional S"
"a ∈ S → carrier R"
using assms function_ring_defs apply auto[1]
using assms function_ring_defs PiE_iff apply blast
using assms function_ring_defs(1) by fastforce
lemma(in ring_functions) function_ring_car_closed:
assumes "a ∈ S"
assumes "f ∈ carrier F"
shows "f a ∈ carrier R"
using assms unfolding function_ring_def F_def by auto
lemma(in ring_functions) function_ring_not_car:
assumes "a ∉ S"
assumes "f ∈ carrier F"
shows "f a = undefined"
using assms unfolding function_ring_def F_def by auto
lemma(in ring_functions) function_ring_car_eqI:
assumes "f ∈ carrier F"
assumes "g ∈ carrier F"
assumes "⋀a. a ∈ S ⟹ f a = g a"
shows "f = g"
using assms(1) assms(2) assms(3) extensionalityI function_ring_car_memE(1) by blast
lemma(in ring_functions) function_ring_car_memI:
assumes "⋀a. a ∈ S ⟹ f a ∈ carrier R"
assumes "⋀ a. a ∉ S⟹ f a = undefined"
shows "f ∈ carrier F"
using function_ring_defs assms
unfolding extensional_funcset_def
by (simp add: ‹⋀a. a ∈ S ⟹ f a ∈ carrier R› extensional_def)
lemma(in ring) function_ring_car_memI:
assumes "⋀a. a ∈ S ⟹ f a ∈ carrier R"
assumes "⋀ a. a ∉ S⟹ f a = undefined"
shows "f ∈ carrier (function_ring S R)"
by (simp add: assms(1) assms(2) local.ring_axioms ring_functions.function_ring_car_memI ring_functions.intro)
subsubsection‹Basic Multiplication Facts›
lemma(in ring_functions) function_mult_eval_car:
assumes "a ∈ S"
assumes "f ∈ carrier F"
assumes "g ∈ carrier F"
shows "(f ⊗⇘F⇙ g) a = (f a) ⊗ (g a)"
using assms function_ring_defs
unfolding function_mult_def
by simp
lemma(in ring_functions) function_mult_eval_closed:
assumes "a ∈ S"
assumes "f ∈ carrier F"
assumes "g ∈ carrier F"
shows "(f ⊗⇘F⇙ g) a ∈ carrier R"
using assms function_mult_eval_car
using F_def ring_functions.function_ring_car_closed ring_functions_axioms by fastforce
lemma(in ring_functions) fun_mult_closed:
assumes "f ∈ carrier F"
assumes "g ∈ carrier F"
shows "f ⊗⇘F⇙ g ∈ carrier F"
apply(rule function_ring_car_memI)
apply (simp add: assms(1) assms(2) function_mult_eval_closed)
by (simp add: function_mult_def function_ring_defs(2))
lemma(in ring_functions) fun_mult_eval_assoc:
assumes "x ∈ carrier F"
assumes "y ∈ carrier F"
assumes " z ∈ carrier F"
assumes "a ∈ S"
shows "(x ⊗⇘F⇙ y ⊗⇘F⇙ z) a = (x ⊗⇘F⇙ (y ⊗⇘F⇙ z)) a"
proof-
have 0: "(x ⊗⇘F⇙ y ⊗⇘F⇙ z) a = (x a) ⊗ (y a) ⊗ (z a) "
by (simp add: assms(1) assms(2) assms(3) assms(4) fun_mult_closed function_mult_eval_car)
have 1: "(x ⊗⇘F⇙ (y ⊗⇘F⇙ z)) a = (x a) ⊗ ((y a) ⊗ (z a))"
by (simp add: assms(1) assms(2) assms(3) assms(4) fun_mult_closed function_mult_eval_car)
have 2:"(x ⊗⇘F⇙ (y ⊗⇘F⇙ z)) a = (x a) ⊗ (y a) ⊗ (z a)"
using 1 assms
by (simp add: function_ring_car_closed m_assoc)
show ?thesis
using 0 2 by auto
qed
lemma(in ring_functions) fun_mult_assoc:
assumes "x ∈ carrier F"
assumes "y ∈ carrier F"
assumes "z ∈ carrier F"
shows "(x ⊗⇘F⇙ y ⊗⇘F⇙ z) = (x ⊗⇘F⇙ (y ⊗⇘F⇙ z))"
using fun_mult_eval_assoc[of x]
by (simp add: assms(1) assms(2) assms(3) fun_mult_closed function_ring_car_eqI)
subsubsection‹Basic Addition Facts›
lemma(in ring_functions) fun_add_eval_car:
assumes "a ∈ S"
assumes "f ∈ carrier F"
assumes "g ∈ carrier F"
shows "(f ⊕⇘F⇙ g) a = (f a) ⊕ (g a)"
by (simp add: assms(1) function_add_def function_ring_defs(3))
lemma(in ring_functions) fun_add_eval_closed:
assumes "a ∈ S"
assumes "f ∈ carrier F"
assumes "g ∈ carrier F"
shows "(f ⊕⇘F⇙ g) a ∈ carrier R"
using assms unfolding F_def
using F_def fun_add_eval_car function_ring_car_closed
by auto
lemma(in ring_functions) fun_add_closed:
assumes "f ∈ carrier F"
assumes "g ∈ carrier F"
shows "f ⊕⇘F⇙ g ∈ carrier F"
apply(rule function_ring_car_memI)
using assms unfolding F_def
using F_def fun_add_eval_closed apply blast
by (simp add: function_add_def function_ring_def)
lemma(in ring_functions) fun_add_eval_assoc:
assumes "x ∈ carrier F"
assumes "y ∈ carrier F"
assumes " z ∈ carrier F"
assumes "a ∈ S"
shows "(x ⊕⇘F⇙ y ⊕⇘F⇙ z) a = (x ⊕⇘F⇙ (y ⊕⇘F⇙ z)) a"
proof-
have 0: "(x ⊕⇘F⇙ y ⊕⇘F⇙ z) a = (x a) ⊕ (y a) ⊕ (z a) "
by (simp add: assms(1) assms(2) assms(3) assms(4) fun_add_closed fun_add_eval_car)
have 1: "(x ⊕⇘F⇙ (y ⊕⇘F⇙ z)) a = (x a) ⊕ ((y a) ⊕ (z a))"
by (simp add: assms(1) assms(2) assms(3) assms(4) fun_add_closed fun_add_eval_car)
have 2:"(x ⊕⇘F⇙ (y ⊕⇘F⇙ z)) a = (x a) ⊕ (y a) ⊕ (z a)"
using 1 assms
by (simp add: add.m_assoc function_ring_car_closed)
show ?thesis
using 0 2 by auto
qed
lemma(in ring_functions) fun_add_assoc:
assumes "x ∈ carrier F"
assumes "y ∈ carrier F"
assumes " z ∈ carrier F"
shows "x ⊕⇘F⇙ y ⊕⇘F⇙ z = x ⊕⇘F⇙ (y ⊕⇘F⇙ z)"
apply(rule function_ring_car_eqI)
using assms apply (simp add: fun_add_closed)
apply (simp add: assms(1) assms(2) assms(3) fun_add_closed)
by (simp add: assms(1) assms(2) assms(3) fun_add_eval_assoc)
lemma(in ring_functions) fun_add_eval_comm:
assumes "a ∈ S"
assumes "x ∈ carrier F"
assumes "y ∈ carrier F"
shows "(x ⊕⇘F⇙ y) a = (y ⊕⇘F⇙ x) a"
by (metis F_def assms(1) assms(2) assms(3) fun_add_eval_car ring.ring_simprules(10) ring_functions.function_ring_car_closed ring_functions_axioms ring_functions_def)
lemma(in ring_functions) fun_add_comm:
assumes "x ∈ carrier F"
assumes "y ∈ carrier F"
shows "x ⊕⇘F⇙ y = y ⊕⇘F⇙ x"
using fun_add_eval_comm assms
by (metis (no_types, hide_lams) fun_add_closed function_ring_car_eqI)
subsubsection‹Basic Facts About the Multiplicative Unit›
lemma(in ring_functions) function_one_eval:
assumes "a ∈ S"
shows "𝟭⇘F⇙ a = 𝟭"
using assms function_ring_defs unfolding function_one_def
by simp
lemma(in ring_functions) function_one_closed:
"𝟭⇘F⇙ ∈carrier F"
apply(rule function_ring_car_memI)
using function_ring_defs
using function_one_eval apply auto[1]
by (simp add: function_one_def function_ring_defs(4))
lemma(in ring_functions) function_times_one_l:
assumes "a ∈ carrier F"
shows "𝟭⇘F⇙ ⊗⇘F⇙ a = a"
proof(rule function_ring_car_eqI)
show "𝟭⇘F⇙ ⊗⇘F⇙ a ∈ carrier F"
using assms fun_mult_closed function_one_closed
by blast
show " a ∈ carrier F"
using assms by simp
show "⋀c. c ∈ S ⟹ (𝟭⇘F⇙ ⊗⇘F⇙ a) c = a c "
by (simp add: assms function_mult_eval_car function_one_eval function_one_closed function_ring_car_closed)
qed
lemma(in ring_functions) function_times_one_r:
assumes "a ∈ carrier F"
shows "a⊗⇘F⇙ 𝟭⇘F⇙ = a"
proof(rule function_ring_car_eqI)
show "a⊗⇘F⇙ 𝟭⇘F⇙ ∈ carrier F"
using assms fun_mult_closed function_one_closed
by blast
show " a ∈ carrier F"
using assms by simp
show "⋀c. c ∈ S ⟹ (a⊗⇘F⇙ 𝟭⇘F⇙) c = a c "
using assms
by (simp add: function_mult_eval_car function_one_eval function_one_closed function_ring_car_closed)
qed
subsubsection‹Basic Facts About the Additive Unit›
lemma(in ring_functions) function_zero_eval:
assumes "a ∈ S"
shows "𝟬⇘F⇙ a = 𝟬"
using assms function_ring_defs
unfolding function_zero_def
by simp
lemma(in ring_functions) function_zero_closed:
"𝟬⇘F⇙ ∈carrier F"
apply(rule function_ring_car_memI)
apply (simp add: function_zero_eval)
by (simp add: function_ring_defs(5) function_zero_def)
lemma(in ring_functions) fun_add_zeroL:
assumes "a ∈ carrier F"
shows "𝟬⇘F⇙ ⊕⇘F⇙ a = a"
proof(rule function_ring_car_eqI)
show "𝟬⇘F⇙ ⊕⇘F⇙ a ∈ carrier F"
using assms fun_add_closed function_zero_closed
by blast
show "a ∈ carrier F"
using assms by simp
show "⋀c. c ∈ S ⟹ (𝟬⇘F⇙ ⊕⇘F⇙ a) c = a c "
using assms F_def fun_add_eval_car function_zero_closed
ring_functions.function_zero_eval ring_functions_axioms
by (simp add: ring_functions.function_zero_eval function_ring_car_closed)
qed
lemma(in ring_functions) fun_add_zeroR:
assumes "a ∈ carrier F"
shows "a ⊕⇘F⇙ 𝟬⇘F⇙ = a"
using assms fun_add_comm fun_add_zeroL
by (simp add: function_zero_closed)
subsubsection‹Distributive Laws›
lemma(in ring_functions) function_mult_r_distr:
assumes "x ∈ carrier F"
assumes" y ∈ carrier F"
assumes " z ∈ carrier F"
shows " (x ⊕⇘F⇙ y) ⊗⇘F⇙ z = x ⊗⇘F⇙ z ⊕⇘F⇙ y ⊗⇘F⇙ z"
proof(rule function_ring_car_eqI)
show "(x ⊕⇘F⇙ y) ⊗⇘F⇙ z ∈ carrier F"
by (simp add: assms(1) assms(2) assms(3) fun_add_closed fun_mult_closed)
show "x ⊗⇘F⇙ z ⊕⇘F⇙ y ⊗⇘F⇙ z ∈ carrier F"
by (simp add: assms(1) assms(2) assms(3) fun_add_closed fun_mult_closed)
show "⋀a. a ∈ S ⟹ ((x ⊕⇘F⇙ y) ⊗⇘F⇙ z) a = (x ⊗⇘F⇙ z ⊕⇘F⇙ y ⊗⇘F⇙ z) a"
proof-
fix a
assume A: "a ∈ S"
show "((x ⊕⇘F⇙ y) ⊗⇘F⇙ z) a = (x ⊗⇘F⇙ z ⊕⇘F⇙ y ⊗⇘F⇙ z) a"
using A assms fun_add_eval_car[of a x y] fun_add_eval_car[of a "x ⊗⇘F⇙z" "y ⊗⇘F⇙ z"]
function_mult_eval_car[of a "x ⊕⇘F⇙ y" z] semiring_simprules(10)
F_def
by (smt fun_add_closed function_mult_eval_car function_ring_car_closed
ring_functions.fun_mult_closed ring_functions_axioms)
qed
qed
lemma(in ring_functions) function_mult_l_distr:
assumes "x ∈ carrier F"
assumes" y ∈ carrier F"
assumes " z ∈ carrier F"
shows "z ⊗⇘F⇙ (x ⊕⇘F⇙ y) = z ⊗⇘F⇙ x ⊕⇘F⇙ z ⊗⇘F⇙ y"
proof(rule function_ring_car_eqI)
show "z ⊗⇘F⇙ (x ⊕⇘F⇙ y) ∈ carrier F"
by (simp add: assms(1) assms(2) assms(3) fun_add_closed fun_mult_closed)
show "z ⊗⇘F⇙ x ⊕⇘F⇙ z ⊗⇘F⇙ y ∈ carrier F"
by (simp add: assms(1) assms(2) assms(3) fun_add_closed fun_mult_closed)
show "⋀a. a ∈ S ⟹ (z ⊗⇘F⇙ (x ⊕⇘F⇙ y)) a = (z ⊗⇘F⇙ x ⊕⇘F⇙ z ⊗⇘F⇙ y) a"
proof-
fix a
assume A: "a ∈ S"
show "(z ⊗⇘F⇙ (x ⊕⇘F⇙ y)) a = (z ⊗⇘F⇙ x ⊕⇘F⇙ z ⊗⇘F⇙ y) a"
using A assms function_ring_defs fun_add_closed fun_mult_closed
function_mult_eval_car[of a z "x ⊕⇘F⇙ y"]
function_mult_eval_car[of a z x]
function_mult_eval_car[of a z y]
fun_add_eval_car[of a x y]
semiring_simprules(13)
fun_add_eval_car function_ring_car_closed by auto
qed
qed
subsubsection‹Additive Inverses›
lemma(in ring_functions) function_uminus_closed:
assumes "f ∈ carrier F"
shows "function_uminus S R f ∈ carrier F"
proof(rule function_ring_car_memI)
show "⋀a. a ∈ S ⟹ function_uminus S R f a ∈ carrier R"
using assms function_ring_car_closed[of _ f] unfolding function_uminus_def
by simp
show "⋀a. a ∉ S ⟹ function_uminus S R f a = undefined"
by (simp add: function_uminus_def)
qed
lemma(in ring_functions) function_uminus_eval:
assumes "a ∈ S"
assumes "f ∈ carrier F"
shows "(function_uminus S R f) a = ⊖ (f a)"
using assms unfolding function_uminus_def
by simp
lemma(in ring_functions) function_uminus_add_r:
assumes "a ∈ S"
assumes "f ∈ carrier F"
shows "f ⊕⇘F⇙ function_uminus S R f = 𝟬⇘F⇙"
apply(rule function_ring_car_eqI)
using assms fun_add_closed function_uminus_closed apply blast
unfolding F_def using F_def function_zero_closed apply blast
using F_def assms(2) fun_add_eval_car function_ring_car_closed function_uminus_closed
function_uminus_eval function_zero_eval r_neg by auto
lemma(in ring_functions) function_uminus_add_l:
assumes "a ∈ S"
assumes "f ∈ carrier F"
shows "function_uminus S R f ⊕⇘F⇙ f = 𝟬⇘F⇙"
using assms(1) assms(2) fun_add_comm function_uminus_add_r function_uminus_closed by auto
subsubsection‹Scalar Multiplication›
lemma(in ring_functions) function_smult_eval:
assumes "a ∈ carrier R"
assumes "f ∈ carrier F"
assumes "b ∈ S"
shows "(a ⊙⇘F⇙ f) b = a ⊗ (f b)"
using function_ring_defs(6) unfolding function_scalar_mult_def
by(simp add: assms)
lemma(in ring_functions) function_smult_closed:
assumes "a ∈ carrier R"
assumes "f ∈ carrier F"
shows "a ⊙⇘F⇙ f ∈ carrier F"
apply(rule function_ring_car_memI)
using function_smult_eval assms
apply (simp add: function_ring_car_closed)
using function_scalar_mult_def F_def
by (metis function_ring_defs(6) restrict_apply)
lemma(in ring_functions) function_smult_assoc1:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
assumes "f ∈ carrier F"
shows "b ⊙⇘F⇙ (a ⊙⇘F⇙ f) = (b ⊗ a)⊙⇘F⇙f"
apply(rule function_ring_car_eqI)
using assms function_smult_closed apply simp
using assms function_smult_closed apply simp
by (metis F_def assms(1) assms(2) assms(3) function_mult_eval_closed function_one_closed
function_smult_eval function_times_one_r m_assoc m_closed ring_functions.function_smult_closed ring_functions_axioms)
lemma(in ring_functions) function_smult_assoc2:
assumes "a ∈ carrier R"
assumes "f ∈ carrier F"
assumes "g ∈ carrier F"
shows "(a ⊙⇘F⇙ f)⊗⇘F⇙g = a ⊙⇘F⇙ (f ⊗⇘F⇙ g)"
apply(rule function_ring_car_eqI)
using assms function_smult_closed apply (simp add: fun_mult_closed)
apply (simp add: assms(1) assms(2) assms(3) fun_mult_closed function_smult_closed)
by (metis (full_types) F_def assms(1) assms(2) assms(3) fun_mult_closed
function_mult_eval_car function_smult_closed function_smult_eval m_assoc ring_functions.function_ring_car_closed ring_functions_axioms)
lemma(in ring_functions) function_smult_one:
assumes "f ∈ carrier F"
shows "𝟭⊙⇘F⇙f = f"
apply(rule function_ring_car_eqI)
apply (simp add: assms function_smult_closed)
apply (simp add: assms)
by (simp add: assms function_ring_car_closed function_smult_eval)
lemma(in ring_functions) function_smult_l_distr:
"[| a ∈ carrier R; b ∈ carrier R; x ∈ carrier F |] ==>
(a ⊕ b) ⊙⇘F⇙ x = a ⊙⇘F⇙ x ⊕⇘F⇙ b ⊙⇘F⇙ x"
apply(rule function_ring_car_eqI)
apply (simp add: function_smult_closed)
apply (simp add: fun_add_closed function_smult_closed)
using function_smult_eval
by (simp add: fun_add_eval_car function_ring_car_closed function_smult_closed l_distr)
lemma(in ring_functions) function_smult_r_distr:
"[| a ∈ carrier R; x ∈ carrier F; y ∈ carrier F |] ==>
a ⊙⇘F⇙ (x ⊕⇘F⇙ y) = a ⊙⇘F⇙ x ⊕⇘F⇙ a ⊙⇘F⇙ y"
apply(rule function_ring_car_eqI)
apply (simp add: fun_add_closed function_smult_closed)
apply (simp add: fun_add_closed function_smult_closed)
by (simp add: fun_add_closed fun_add_eval_car function_ring_car_closed function_smult_closed function_smult_eval r_distr)
subsubsection‹The Ring of Functions Forms an Algebra›
lemma(in ring_functions) function_ring_is_abelian_group:
"abelian_group F"
apply(rule abelian_groupI)
apply (simp add: fun_add_closed)
apply (simp add: function_zero_closed)
using fun_add_assoc apply simp
apply (simp add: fun_add_comm)
apply (simp add: fun_add_comm fun_add_zeroR function_zero_closed)
using fun_add_zeroL function_ring_car_eqI function_uminus_add_l
function_uminus_closed function_zero_closed by blast
lemma(in ring_functions) function_ring_is_monoid:
"monoid F"
apply(rule monoidI)
apply (simp add: fun_mult_closed)
apply (simp add: function_one_closed)
apply (simp add: fun_mult_assoc)
apply (simp add: function_times_one_l)
by (simp add: function_times_one_r)
lemma(in ring_functions) function_ring_is_ring:
"ring F"
apply(rule ringI)
apply (simp add: function_ring_is_abelian_group)
apply (simp add: function_ring_is_monoid)
apply (simp add: function_mult_r_distr)
by (simp add: function_mult_l_distr)
sublocale ring_functions < F?: ring F
by (rule function_ring_is_ring)
lemma(in cring_functions) function_mult_comm:
assumes "x ∈ carrier F"
assumes" y ∈ carrier F"
shows "x ⊗⇘F⇙ y = y ⊗⇘F⇙ x"
apply(rule function_ring_car_eqI)
apply (simp add: assms(1) assms(2) fun_mult_closed)
apply (simp add: assms(1) assms(2) fun_mult_closed)
by (simp add: assms(1) assms(2) function_mult_eval_car function_ring_car_closed m_comm)
lemma(in cring_functions) function_ring_is_comm_monoid:
"comm_monoid F"
apply(rule comm_monoidI)
using fun_mult_assoc function_one_closed
apply (simp add: fun_mult_closed)
apply (simp add: function_one_closed)
apply (simp add: fun_mult_assoc)
apply (simp add: function_times_one_l)
by (simp add: function_mult_comm)
lemma(in cring_functions) function_ring_is_cring:
"cring F"
apply(rule cringI)
apply (simp add: function_ring_is_abelian_group)
apply (simp add: function_ring_is_comm_monoid)
by (simp add: function_mult_r_distr)
lemma(in cring_functions) function_ring_is_algebra:
"algebra R F"
apply(rule algebraI)
apply (simp add: is_cring)
apply (simp add: function_ring_is_cring)
using function_smult_closed apply blast
apply (simp add: function_smult_l_distr)
apply (simp add: function_smult_r_distr)
apply (simp add: function_smult_assoc1)
apply (simp add: function_smult_one)
by (simp add: function_smult_assoc2)
lemma(in ring_functions) function_uminus:
assumes "f ∈ carrier F"
shows "⊖⇘F⇙ f = (function_uminus S R) f"
using assms a_inv_def[of F]
by (metis F_def abelian_group.a_group abelian_group.r_neg function_uminus_add_r function_uminus_closed group.inv_closed partial_object.select_convs(1) ring.ring_simprules(18) ring_functions.function_ring_car_eqI ring_functions.function_ring_is_abelian_group ring_functions.function_ring_is_ring ring_functions_axioms)
lemma(in ring_functions) function_uminus_eval':
assumes "f ∈ carrier F"
assumes "a ∈ S"
shows "(⊖⇘F⇙ f) a = (function_uminus S R) f a"
using assms
by (simp add: function_uminus)
lemma(in ring_functions) function_uminus_eval'':
assumes "f ∈ carrier F"
assumes "a ∈ S"
shows "(⊖⇘F⇙ f) a = ⊖ (f a)"
using assms(1) assms(2) function_uminus
by (simp add: function_uminus_eval)
sublocale cring_functions < F?: algebra R F
using function_ring_is_algebra by auto
subsection‹Constant Functions›
definition constant_function where
"constant_function S a =(λx ∈ S. a)"
abbreviation(in ring_functions)(input) const where
"const ≡ constant_function S"
lemma(in ring_functions) constant_function_closed:
assumes "a ∈ carrier R"
shows "const a ∈ carrier F"
apply(rule function_ring_car_memI)
unfolding constant_function_def
apply (simp add: assms)
by simp
lemma(in ring_functions) constant_functionE:
assumes "a ∈ carrier R"
assumes "b ∈ S"
shows "const a b = a"
by (simp add: assms(2) constant_function_def)
lemma(in ring_functions) constant_function_add:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "const (a ⊕⇘R⇙ b) = (const a) ⊕⇘F⇙ (const b) "
apply(rule function_ring_car_eqI)
apply (simp add: constant_function_closed assms(1) assms(2))
using assms(1) constant_function_closed assms(2) fun_add_closed apply auto[1]
by (simp add: assms(1) assms(2) constant_function_closed constant_functionE fun_add_eval_car)
lemma(in ring_functions) constant_function_mult:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "const (a ⊗⇘R⇙ b) = (const a) ⊗⇘F⇙ (const b)"
apply(rule function_ring_car_eqI)
apply (simp add: constant_function_closed assms(1) assms(2))
using assms(1) constant_function_closed assms(2) fun_mult_closed apply auto[1]
by (simp add: constant_function_closed assms(1) assms(2) constant_functionE function_mult_eval_car)
lemma(in ring_functions) constant_function_minus:
assumes "a ∈ carrier R"
shows "⊖⇘F⇙(const a) = (const (⊖⇘R⇙ a)) "
apply(rule function_ring_car_eqI)
apply (simp add: constant_function_closed assms local.function_uminus)
apply (simp add: constant_function_closed assms function_uminus_closed)
apply (simp add: constant_function_closed assms)
by (simp add: constant_function_closed assms constant_functionE function_uminus_eval'')
lemma(in ring_functions) function_one_is_constant:
"const 𝟭 = 𝟭⇘F⇙"
unfolding F_def
apply(rule function_ring_car_eqI)
apply (simp add: constant_function_closed)
using F_def function_one_closed apply auto[1]
using F_def constant_functionE function_one_eval by auto
lemma(in ring_functions) function_zero_is_constant:
"const 𝟬 = 𝟬⇘F⇙"
apply(rule function_ring_car_eqI)
apply (simp add: constant_function_closed)
using F_def function_zero_closed apply auto[1]
using F_def constant_functionE function_zero_eval by auto
subsection‹Special Examples of Functions Rings›
subsubsection‹Functions from the Carrier of a Ring to Itself›
locale U_function_ring = ring
locale U_function_cring = U_function_ring + cring
sublocale U_function_ring < S?: struct_functions R "carrier R"
done
sublocale U_function_ring < FunR?: ring_functions R "carrier R" "Fun R"
apply (simp add: local.ring_axioms ring_functions.intro)
by simp
sublocale U_function_cring < FunR?: cring_functions R "carrier R" "Fun R"
apply (simp add: cring_functions_def is_cring ring_functions_axioms)
by simp
abbreviation(in U_function_ring)(input) ring_compose :: "('a ⇒ 'a) ⇒ ('a ⇒ 'a) ⇒ ('a ⇒ 'a)" where
"ring_compose ≡ compose (carrier R)"
lemma(in U_function_ring) ring_function_ring_comp:
assumes "f ∈ carrier (Fun R)"
assumes "g ∈ carrier (Fun R)"
shows "ring_compose f g ∈ carrier (Fun R)"
apply(rule function_ring_car_memI)
apply (simp add: assms(1) assms(2) compose_eq)
apply (simp add: assms(1) assms(2) function_ring_car_closed)
by (meson compose_extensional extensional_arb)
abbreviation(in U_function_ring)(input) ring_const ("𝔠ı") where
"ring_const ≡ constant_function (carrier R)"
lemma(in ring_functions) function_nat_pow_eval:
assumes "f ∈ carrier F"
assumes "s ∈ S"
shows "(f[^]⇘F⇙(n::nat)) s = (f s)[^]n"
apply(induction n)
using assms(2) function_one_eval apply auto[1]
by (simp add: assms(1) assms(2) function_mult_eval_car function_ring_is_monoid monoid.nat_pow_closed)
context U_function_ring
begin
definition a_translate :: "'a ⇒ 'a ⇒ 'a" where
"a_translate = (λ r ∈ carrier R. restrict ((add R) r) (carrier R))"
definition m_translate :: "'a ⇒ 'a ⇒ 'a" where
"m_translate = (λ r ∈ carrier R. restrict ((mult R) r) (carrier R))"
definition nat_power :: "nat ⇒ 'a ⇒ 'a" where
"nat_power = (λ(n::nat). restrict (λa. a[^]⇘R⇙n) (carrier R)) "
text‹Restricted operations are in Fs›
lemma a_translate_functions:
assumes "c ∈ carrier R"
shows "a_translate c ∈ carrier (Fun R)"
apply(rule function_ring_car_memI)
using assms a_translate_def
apply simp
using assms a_translate_def
by simp
lemma m_translate_functions:
assumes "c ∈ carrier R"
shows "m_translate c ∈ carrier (Fun R)"
apply(rule function_ring_car_memI)
using assms m_translate_def
apply simp
using assms m_translate_def
by simp
lemma nat_power_functions:
shows "nat_power n ∈ carrier (Fun R)"
apply(rule function_ring_car_memI)
using nat_power_def
apply simp
by (simp add: nat_power_def)
text‹Restricted operations simps›
lemma a_translate_eq:
assumes "c ∈ carrier R"
assumes "a ∈ carrier R"
shows "a_translate c a = c ⊕ a"
by (simp add: a_translate_def assms(1) assms(2))
lemma a_translate_eq':
assumes "c ∈ carrier R"
assumes "a ∉ carrier R"
shows "a_translate c a = undefined"
by (meson a_translate_functions assms(1) assms(2) function_ring_not_car)
lemma a_translate_eq'':
assumes "c ∉ carrier R"
shows "a_translate c = undefined"
by (simp add: a_translate_def assms)
lemma m_translate_eq:
assumes "c ∈ carrier R"
assumes "a ∈ carrier R"
shows "m_translate c a = c ⊗ a"
by (simp add: m_translate_def assms(1) assms(2))
lemma m_translate_eq':
assumes "c ∈ carrier R"
assumes "a ∉ carrier R"
shows "m_translate c a = undefined "
by (meson m_translate_functions assms(1) assms(2) function_ring_not_car)
lemma m_translate_eq'':
assumes "c ∉ carrier R"
shows "m_translate c = undefined"
by (simp add: m_translate_def assms)
lemma nat_power_eq:
assumes "a ∈ carrier R"
shows "nat_power n a = a[^]⇘R⇙ n"
by (simp add: assms nat_power_def)
lemma nat_power_eq':
assumes "a ∉ carrier R"
shows "nat_power n a = undefined"
by (simp add: assms nat_power_def)
text‹Constant ring\_function properties›
lemma constant_function_eq:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "𝔠⇘a⇙ b = a"
using assms
by (simp add: constant_functionE)
lemma constant_function_eq':
assumes "a ∈ carrier R"
assumes "b ∉ carrier R"
shows "𝔠⇘a⇙ b = undefined"
by (simp add: constant_function_closed assms(1) assms(2) function_ring_not_car)
text‹Compound expressions from algebraic operations›
end
definition monomial_function where
"monomial_function R c (n::nat) = (λ x ∈ carrier R. c ⊗⇘R⇙ (x[^]⇘R⇙n))"
context U_function_ring
begin
abbreviation monomial where
"monomial ≡ monomial_function R"
lemma monomial_functions:
assumes "c ∈ carrier R"
shows "monomial c n ∈ carrier (Fun R)"
apply(rule function_ring_car_memI)
unfolding monomial_function_def
apply (simp add: assms)
by simp
definition ring_id where
"ring_id ≡ restrict (λx. x) (carrier R) "
lemma ring_id_closed[simp]:
"ring_id ∈ carrier (Fun R)"
by (simp add: function_ring_car_memI ring_id_def)
lemma ring_id_eval:
assumes "a ∈ carrier R"
shows "ring_id a = a"
using assms unfolding ring_id_def
by simp
lemma constant_a_trans:
assumes "a ∈carrier R"
shows "m_translate a = 𝔠⇘a⇙ ⊗⇘Fun R⇙ ring_id"
proof(rule function_ring_car_eqI)
show "m_translate a ∈ carrier (Fun R)"
using assms
using m_translate_functions by blast
show "𝔠⇘a⇙ ⊗⇘Fun R⇙ ring_id ∈ carrier (Fun R)"
unfolding ring_id_def
using assms ring_id_closed ring_id_def
by (simp add: constant_function_closed fun_mult_closed)
show "⋀x. x ∈ carrier R ⟹ m_translate a x = (𝔠⇘a⇙ ⊗⇘Fun R⇙ ring_id) x"
by (simp add: constant_function_closed assms constant_function_eq function_mult_eval_car m_translate_eq ring_id_eval)
qed
text‹polynomials in one variable›
fun polynomial :: "'a list ⇒ ('a ⇒ 'a)" where
"polynomial [] = 𝟬⇘Fun R⇙ "|
"polynomial (a#as) = (λx ∈ carrier R. a ⊕ x ⊗ (polynomial as x))"
lemma polynomial_induct_lemma:
assumes "f ∈ carrier (Fun R)"
assumes "a ∈ carrier R"
shows "(λx ∈ carrier R. a ⊕ x ⊗ (f x)) ∈ carrier (Fun R)"
proof(rule function_ring_car_memI)
show "⋀aa. aa ∈ carrier R ⟹ (λx∈carrier R. a ⊕ x ⊗ f x) aa ∈ carrier R"
proof- fix y assume A: "y ∈ carrier R"
have "a ⊕ y ⊗ f y ∈ carrier R"
using A assms(1) assms(2) function_ring_car_closed by blast
thus "(λx∈carrier R. a ⊕ x ⊗ f x) y ∈ carrier R"
using A by auto
qed
show "⋀aa. aa ∉ carrier R ⟹ (λx∈carrier R. a ⊕ x ⊗ f x) aa = undefined"
by auto
qed
lemma polynomial_function:
shows "set as ⊆ carrier R ⟹ polynomial as ∈ carrier (Fun R)"
proof(induction as)
case Nil
then show ?case
by (simp add: function_zero_closed)
next
case (Cons a as)
then show "polynomial (a # as) ∈ carrier (function_ring (carrier R) R)"
using polynomial.simps(2)[of a as] polynomial_induct_lemma[of "polynomial as" a]
by simp
qed
lemma polynomial_constant:
assumes "a ∈ carrier R"
shows "polynomial [a] = 𝔠⇘a⇙"
apply(rule function_ring_car_eqI)
using assms polynomial_function
apply (metis (full_types) list.distinct(1) list.set_cases set_ConsD subset_code(1))
apply (simp add: constant_function_closed assms)
using polynomial.simps(2)[of a "[]"] polynomial.simps(1) assms
by (simp add: constant_function_eq function_zero_eval)
end
subsubsection‹Sequences Indexed by the Natural Numbers›
definition nat_seqs ("_⇗ω⇖")where
"nat_seqs R ≡ function_ring (UNIV::nat set) R"
abbreviation(input) closed_seqs where
"closed_seqs R ≡ carrier (R⇗ω⇖)"
lemma closed_seqs_memI:
assumes "⋀k. s k ∈ carrier R"
shows "s ∈ closed_seqs R"
unfolding nat_seqs_def function_ring_def
by (simp add: PiE_UNIV_domain assms)
lemma closed_seqs_memE:
assumes "s ∈ closed_seqs R"
shows "s k ∈ carrier R"
using assms unfolding nat_seqs_def function_ring_def
by (simp add: PiE_iff)
definition is_constant_fun where
"is_constant_fun R f = (∃x ∈ carrier R. f = constant_function (carrier R) R x)"
definition is_constant_seq where
"is_constant_seq R s = (∃x ∈ carrier R. s = constant_function (UNIV::nat set) x)"
lemma is_constant_seqI:
fixes a
assumes "s ∈ closed_seqs R"
assumes "⋀k. s k = a"
shows "is_constant_seq R s"
unfolding is_constant_seq_def constant_function_def
by (metis assms(1) assms(2) closed_seqs_memE restrict_UNIV restrict_ext)
lemma is_constant_seqE:
assumes "is_constant_seq R s"
assumes "s k = a"
shows "s n = a"
using assms unfolding is_constant_seq_def
by (metis constant_function_def restrict_UNIV)
lemma is_constant_seq_imp_closed:
assumes "is_constant_seq R s"
shows "s ∈ closed_seqs R"
apply(rule closed_seqs_memI)
using assms unfolding is_constant_seq_def constant_function_def
by auto
context U_function_ring
begin
text‹Sequence sums and products are closed›
lemma seq_plus_closed:
assumes "s ∈ closed_seqs R"
assumes "s' ∈ closed_seqs R"
shows "s ⊕⇘R⇗ω⇖⇙ s' ∈ closed_seqs R"
by (metis assms(1) assms(2) nat_seqs_def ring_functions.fun_add_closed ring_functions_axioms)
lemma seq_mult_closed:
assumes "s ∈ closed_seqs R"
assumes "s' ∈ closed_seqs R"
shows "s ⊗⇘R⇗ω⇖⇙ s' ∈ closed_seqs R"
apply(rule closed_seqs_memI)
by (metis assms(1) assms(2) closed_seqs_memE nat_seqs_def ring_functions.fun_mult_closed ring_functions_axioms)
lemma constant_function_comp_is_closed_seq:
assumes "a ∈ carrier R"
assumes "s ∈ closed_seqs R"
shows "(const a ∘ s) ∈ closed_seqs R"
by (simp add: constant_functionE assms(1) assms(2) closed_seqs_memE closed_seqs_memI)
lemma constant_function_comp_is_constant_seq:
assumes "a ∈ carrier R"
assumes "s ∈ closed_seqs R"
shows "is_constant_seq R ((const a) ∘ s)"
apply(rule is_constant_seqI[of _ _ a] )
apply (simp add: assms(1) assms(2) constant_function_comp_is_closed_seq)
using assms(1) assms(2) closed_seqs_memE
by (simp add: closed_seqs_memE constant_functionE)
lemma function_comp_is_closed_seq:
assumes "s ∈ closed_seqs R"
assumes "f ∈ carrier (Fun R)"
shows "f ∘ s ∈ closed_seqs R"
apply(rule closed_seqs_memI)
using assms(1) assms(2) closed_seqs_memE
by (metis comp_apply fun_add_eval_closed fun_add_zeroR function_zero_closed)
lemma function_sum_comp_is_seq_sum:
assumes "s ∈ closed_seqs R"
assumes "f ∈ carrier (Fun R)"
assumes "g ∈ carrier (Fun R)"
shows "(f ⊕⇘Fun R⇙ g) ∘ s = (f ∘ s) ⊕⇘R⇗ω⇖⇙ (g ∘ s)"
apply(rule ring_functions.function_ring_car_eqI[of R _ "UNIV :: nat set"])
apply (simp add: ring_functions_axioms)
using function_comp_is_closed_seq
apply (metis assms(1) assms(2) assms(3) fun_add_closed nat_seqs_def)
apply (metis assms(1) assms(2) assms(3) function_comp_is_closed_seq nat_seqs_def seq_plus_closed)
by (smt UNIV_eq_I assms(1) assms(2) assms(3) closed_seqs_memE comp_apply function_comp_is_closed_seq nat_seqs_def ring_functions.fun_add_eval_car ring_functions_axioms)
lemma function_mult_comp_is_seq_mult:
assumes "s ∈ closed_seqs R"
assumes "f ∈ carrier (Fun R)"
assumes "g ∈ carrier (Fun R)"
shows "(f ⊗⇘Fun R⇙ g) ∘ s = (f ∘ s) ⊗⇘R⇗ω⇖⇙ (g ∘ s)"
apply(rule ring_functions.function_ring_car_eqI[of R _ "UNIV :: nat set"])
apply (simp add: ring_functions_axioms)
using function_comp_is_closed_seq
apply (metis assms(1) assms(2) assms(3) fun_mult_closed nat_seqs_def)
apply (metis assms(1) assms(2) assms(3) function_comp_is_closed_seq nat_seqs_def seq_mult_closed)
by (metis (no_types, lifting) assms(1) assms(2) assms(3) comp_apply function_comp_is_closed_seq nat_seqs_def ring_functions.function_mult_eval_car ring_functions.function_ring_car_closed ring_functions_axioms)
lemma seq_plus_simp:
assumes "s ∈ closed_seqs R"
assumes "t ∈ closed_seqs R"
shows "(s ⊕⇘R⇗ω⇖⇙ t) k = s k ⊕ t k"
using assms unfolding nat_seqs_def
by (simp add: ring_functions.fun_add_eval_car ring_functions_axioms)
lemma seq_mult_simp:
assumes "s ∈ closed_seqs R"
assumes "t ∈ closed_seqs R"
shows "(s ⊗⇘R⇗ω⇖⇙ t) k = s k ⊗ t k"
using assms unfolding nat_seqs_def
by (simp add: ring_functions.function_mult_eval_car ring_functions_axioms)
lemma seq_one_simp:
"𝟭⇘R⇗ω⇖⇙ k = 𝟭"
by (simp add: nat_seqs_def ring_functions.function_one_eval ring_functions_axioms)
lemma seq_zero_simp:
"𝟬⇘R⇗ω⇖⇙ k = 𝟬"
by (simp add: nat_seqs_def ring_functions.function_zero_eval ring_functions_axioms)
lemma(in U_function_ring) ring_id_seq_comp:
assumes "s ∈ closed_seqs R"
shows "ring_id ∘ s = s"
apply(rule ring_functions.function_ring_car_eqI[of R _ "UNIV::nat set"])
using ring_functions_axioms apply auto[1]
apply (metis assms function_comp_is_closed_seq nat_seqs_def ring_id_closed)
apply (metis assms nat_seqs_def)
by (simp add: assms closed_seqs_memE ring_id_eval)
lemma(in U_function_ring) ring_seq_smult_closed:
assumes "s ∈ closed_seqs R"
assumes "a ∈ carrier R"
shows "a ⊙⇘R⇗ω⇖⇙ s ∈ closed_seqs R"
apply(rule closed_seqs_memI)
by (metis assms(1) assms(2) closed_seqs_memE nat_seqs_def ring_functions.function_smult_closed ring_functions_axioms)
lemma(in U_function_ring) ring_seq_smult_eval:
assumes "s ∈ closed_seqs R"
assumes "a ∈ carrier R"
shows "(a ⊙⇘R⇗ω⇖⇙ s) k = a ⊗ (s k)"
by (metis UNIV_I assms(1) assms(2) nat_seqs_def ring_functions.function_smult_eval ring_functions_axioms)
lemma(in U_function_ring) ring_seq_smult_comp_assoc:
assumes "s ∈ closed_seqs R"
assumes "f ∈ carrier (Fun R)"
assumes "a ∈ carrier R"
shows "((a ⊙⇘Fun R⇙ f) ∘ s) = a ⊙⇘R⇗ω⇖⇙ (f ∘ s)"
apply(rule ext)
using function_smult_eval[of a f] ring_seq_smult_eval[of "f ∘ s" a]
by (simp add: assms(1) assms(2) assms(3) closed_seqs_memE function_comp_is_closed_seq)
end
section‹Extensional Maps Between the Carriers of two Structures›
definition struct_maps :: "('a, 'c) partial_object_scheme ⇒ ('b, 'd) partial_object_scheme
⇒ ('a ⇒ 'b) set" where
"struct_maps T S = {f. (f ∈ (carrier T) → (carrier S)) ∧ f = restrict f (carrier T) }"
definition to_struct_map where
"to_struct_map T f = restrict f (carrier T)"
lemma to_struct_map_closed:
assumes "f ∈ (carrier T) → (carrier S)"
shows "to_struct_map T f ∈ (struct_maps T S)"
by (smt PiE_restrict Pi_iff assms mem_Collect_eq restrict_PiE struct_maps_def to_struct_map_def)
lemma struct_maps_memI:
assumes "⋀ x. x ∈ carrier T ⟹ f x ∈ carrier S"
assumes "⋀x. x ∉ carrier T ⟹ f x = undefined"
shows "f ∈ struct_maps T S"
proof-
have 0: " (f ∈ (carrier T) → (carrier S))"
using assms
by blast
have 1: "f = restrict f (carrier T)"
using assms
by (simp add: extensional_def extensional_restrict)
show ?thesis
using 0 1
unfolding struct_maps_def
by blast
qed
lemma struct_maps_memE:
assumes "f ∈ struct_maps T S"
shows "⋀ x. x ∈ carrier T ⟹ f x ∈ carrier S"
"⋀x. x ∉ carrier T ⟹ f x = undefined"
using assms unfolding struct_maps_def
apply blast
using assms unfolding struct_maps_def
by (metis (mono_tags, lifting) mem_Collect_eq restrict_apply)
text‹An abbreviation for restricted composition of function of functions. This is necessary for the composition of two struct maps to again be a struct map.›
abbreviation(input) rcomp
where "rcomp ≡ FuncSet.compose"
lemma struct_map_comp:
assumes "g ∈ (struct_maps T S)"
assumes "f ∈ (struct_maps S U)"
shows "rcomp (carrier T) f g ∈ (struct_maps T U)"
proof(rule struct_maps_memI)
show "⋀x. x ∈ carrier T ⟹ rcomp (carrier T) f g x ∈ carrier U"
using assms struct_maps_memE(1)
by (metis compose_eq)
show " ⋀x. x ∉ carrier T ⟹ rcomp (carrier T) f g x = undefined"
by (meson compose_extensional extensional_arb)
qed
lemma r_comp_is_compose:
assumes "g ∈ (struct_maps T S)"
assumes "f ∈ (struct_maps S U)"
assumes "a ∈ (carrier T)"
shows "(rcomp (carrier T) f g) a = (f ∘ g) a"
by (simp add: FuncSet.compose_def assms(3))
lemma r_comp_not_in_car:
assumes "g ∈ (struct_maps T S)"
assumes "f ∈ (struct_maps S U)"
assumes "a ∉ (carrier T)"
shows "(rcomp (carrier T) f g) a = undefined"
by (simp add: FuncSet.compose_def assms(3))
text‹The reverse composition of two struct maps:›
definition pullback ::
"('a, 'd) partial_object_scheme ⇒ ('a ⇒ 'b) ⇒ ('b ⇒ 'c) ⇒ ('a ⇒ 'c)" where
"pullback T f g = rcomp (carrier T) g f"
lemma pullback_closed:
assumes "f ∈ (struct_maps T S)"
assumes "g ∈ (struct_maps S U)"
shows "pullback T f g ∈ (struct_maps T U)"
by (metis assms(1) assms(2) pullback_def struct_map_comp)
text‹Composition of struct maps which takes the structure itself rather than the carrier as a parameter:›
definition pushforward ::
"('a, 'd) partial_object_scheme ⇒ ('b ⇒ 'c) ⇒ ('a ⇒ 'b) ⇒ ('a ⇒ 'c)" where
"pushforward T f g ≡ rcomp (carrier T) f g"
lemma pushforward_closed:
assumes "g ∈ (struct_maps T S)"
assumes "f ∈ (struct_maps S U)"
shows "pushforward T f g ∈ (struct_maps T U)"
using assms(1) assms(2) struct_map_comp
by (metis pushforward_def)
end
Theory Cring_Poly
theory Cring_Poly
imports "HOL-Algebra.UnivPoly" "HOL-Algebra.Subrings" Function_Ring
begin
text‹
This theory extends the material in \<^theory>‹HOL-Algebra.UnivPoly›. The main additions are
material on Taylor expansions of polynomials and polynomial derivatives, and various applications
of the universal property of polynomial evaluation. These include construing polynomials as
functions from the base ring to itself, composing one polynomial with another, and extending
homomorphisms between rings to homomoprhisms of their polynomial rings. These formalizations
are necessary components of the proof of Hensel's lemma for $p$-adic integers, and for the
proof of $p$-adic quantifier elimination. ›
lemma(in ring) ring_hom_finsum:
assumes "h ∈ ring_hom R S"
assumes "ring S"
assumes "finite I"
assumes "F ∈ I → carrier R"
shows "h (finsum R F I) = finsum S (h ∘ F) I"
proof-
have I: "(h ∈ ring_hom R S ∧ F ∈ I → carrier R) ⟶ h (finsum R F I) = finsum S (h ∘ F) I"
apply(rule finite_induct, rule assms)
using assms ring_hom_zero[of h R S]
apply (metis abelian_group_def abelian_monoid.finsum_empty is_ring ring_def)
proof(rule)
fix A a
assume A: "finite A" "a ∉ A" "h ∈ ring_hom R S ∧ F ∈ A → carrier R ⟶
h (finsum R F A) = finsum S (h ∘ F) A" "h ∈ ring_hom R S ∧ F ∈ insert a A → carrier R"
have 0: "h ∈ ring_hom R S ∧ F ∈ A → carrier R "
using A by auto
have 1: "h (finsum R F A) = finsum S (h ∘ F) A"
using A 0 by auto
have 2: "abelian_monoid S"
using assms ring_def abelian_group_def by auto
have 3: "h (F a ⊕ finsum R F A) = h (F a) ⊕⇘S⇙ (finsum S (h ∘ F) A) "
using ring_hom_add assms finsum_closed 1 A(4) by fastforce
have 4: "finsum R F (insert a A) = F a ⊕ finsum R F A"
using finsum_insert[of A a F] A assms by auto
have 5: "finsum S (h ∘ F) (insert a A) = (h ∘ F) a ⊕⇘S⇙ finsum S (h ∘ F) A"
apply(rule abelian_monoid.finsum_insert[of S A a "h ∘ F"])
apply (simp add: "2")
apply(rule A)
apply(rule A)
using ring_hom_closed A "0" apply fastforce
using A ring_hom_closed by auto
show "h (finsum R F (insert a A)) =
finsum S (h ∘ F) (insert a A)"
unfolding 4 5 3 by auto
qed
thus ?thesis using assms by blast
qed
lemma(in ring) ring_hom_a_inv:
assumes "ring S"
assumes "h ∈ ring_hom R S"
assumes "b ∈ carrier R"
shows "h (⊖ b) = ⊖⇘S⇙ h b"
proof-
have "h b ⊕⇘S⇙ h (⊖ b) = 𝟬⇘S⇙"
by (metis (no_types, hide_lams) abelian_group.a_inv_closed assms(1) assms(2) assms(3)
is_abelian_group local.ring_axioms r_neg ring_hom_add ring_hom_zero)
then show ?thesis
by (metis (no_types, lifting) abelian_group.minus_equality add.inv_closed assms(1)
assms(2) assms(3) ring.is_abelian_group ring.ring_simprules(10) ring_hom_closed)
qed
lemma(in ring) ring_hom_minus:
assumes "ring S"
assumes "h ∈ ring_hom R S"
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "h (a ⊖ b) = h a ⊖⇘S⇙ h b"
using assms ring_hom_add[of h R S a "⊖⇘R⇙ b"]
unfolding a_minus_def
using ring_hom_a_inv[of S h b] by auto
lemma ring_hom_nat_pow:
assumes "ring R"
assumes "ring S"
assumes "h ∈ ring_hom R S"
assumes "a ∈ carrier R"
shows "h (a[^]⇘R⇙(n::nat)) = (h a)[^]⇘S⇙(n::nat)"
using assms by (simp add: ring_hom_ring.hom_nat_pow ring_hom_ringI2)
lemma (in ring) Units_not_right_zero_divisor:
assumes "a ∈ Units R"
assumes "b ∈ carrier R"
assumes "a ⊗ b = 𝟬"
shows "b = 𝟬"
proof-
have "inv a ⊗ a ⊗ b = 𝟬 "
using assms Units_closed Units_inv_closed r_null m_assoc[of "inv a" a b] by presburger
thus ?thesis using assms
by (metis Units_l_inv l_one)
qed
lemma (in ring) Units_not_left_zero_divisor:
assumes "a ∈ Units R"
assumes "b ∈ carrier R"
assumes "b ⊗ a = 𝟬"
shows "b = 𝟬"
proof-
have "b ⊗ (a ⊗ inv a) = 𝟬 "
using assms Units_closed Units_inv_closed l_null m_assoc[of b a"inv a"] by presburger
thus ?thesis using assms
by (metis Units_r_inv r_one)
qed
lemma (in cring) finsum_remove:
assumes "⋀i. i ∈ Y ⟹ f i ∈ carrier R"
assumes "finite Y"
assumes "i ∈ Y"
shows "finsum R f Y = f i ⊕ finsum R f (Y - {i})"
proof-
have "finsum R f (insert i (Y - {i})) = f i ⊕ finsum R f (Y - {i})"
apply(rule finsum_insert)
using assms apply blast apply blast using assms apply blast
using assms by blast
thus ?thesis using assms
by (metis insert_Diff)
qed
type_synonym degree = nat
text‹The composition of two ring homomorphisms is a ring homomorphism›
lemma ring_hom_compose:
assumes "ring R"
assumes "ring S"
assumes "ring T"
assumes "h ∈ ring_hom R S"
assumes "g ∈ ring_hom S T"
assumes "⋀c. c ∈ carrier R ⟹ f c = g (h c)"
shows "f ∈ ring_hom R T"
proof(rule ring_hom_memI)
show "⋀x. x ∈ carrier R ⟹ f x ∈ carrier T"
using assms by (metis ring_hom_closed)
show " ⋀x y. x ∈ carrier R ⟹ y ∈ carrier R ⟹ f (x ⊗⇘R⇙ y) = f x ⊗⇘T⇙ f y"
proof-
fix x y
assume A: "x ∈ carrier R" "y ∈ carrier R"
show "f (x ⊗⇘R⇙ y) = f x ⊗⇘T⇙ f y"
proof-
have "f (x ⊗⇘R⇙ y) = g (h (x ⊗⇘R⇙ y))"
by (simp add: A(1) A(2) assms(1) assms(6) ring.ring_simprules(5))
then have "f (x ⊗⇘R⇙ y) = g ((h x) ⊗⇘S⇙ (h y))"
using A(1) A(2) assms(4) ring_hom_mult by fastforce
then have "f (x ⊗⇘R⇙ y) = g (h x) ⊗⇘T⇙ g (h y)"
using A(1) A(2) assms(4) assms(5) ring_hom_closed ring_hom_mult by fastforce
then show ?thesis
by (simp add: A(1) A(2) assms(6))
qed
qed
show "⋀x y. x ∈ carrier R ⟹ y ∈ carrier R ⟹ f (x ⊕⇘R⇙ y) = f x ⊕⇘T⇙ f y"
proof-
fix x y
assume A: "x ∈ carrier R" "y ∈ carrier R"
show "f (x ⊕⇘R⇙ y) = f x ⊕⇘T⇙ f y"
proof-
have "f (x ⊕⇘R⇙ y) = g (h (x ⊕⇘R⇙ y))"
by (simp add: A(1) A(2) assms(1) assms(6) ring.ring_simprules(1))
then have "f (x ⊕⇘R⇙ y) = g ((h x) ⊕⇘S⇙ (h y))"
using A(1) A(2) assms(4) ring_hom_add by fastforce
then have "f (x ⊕⇘R⇙ y) = g (h x) ⊕⇘T⇙ g (h y)"
by (metis (no_types, hide_lams) A(1) A(2) assms(4) assms(5) ring_hom_add ring_hom_closed)
then show ?thesis
by (simp add: A(1) A(2) assms(6))
qed
qed
show "f 𝟭⇘R⇙ = 𝟭⇘T⇙"
by (metis assms(1) assms(4) assms(5) assms(6) ring.ring_simprules(6) ring_hom_one)
qed
section‹Basic Notions about Polynomials›
context UP_ring
begin
text‹rings are closed under monomial terms›
lemma monom_term_car:
assumes "c ∈ carrier R"
assumes "x ∈ carrier R"
shows "c ⊗ x[^](n::nat) ∈ carrier R"
using assms monoid.nat_pow_closed
by blast
text‹Univariate polynomial ring over R›
lemma P_is_UP_ring:
"UP_ring R"
by (simp add: UP_ring_axioms)
text‹Degree function›
abbreviation(input) degree where
"degree f ≡ deg R f"
lemma UP_car_memI:
assumes "⋀n. n > k ⟹ p n = 𝟬"
assumes "⋀n. p n ∈ carrier R"
shows "p ∈ carrier P"
proof-
have "bound 𝟬 k p"
by (simp add: assms(1) bound.intro)
then show ?thesis
by (metis (no_types, lifting) P_def UP_def assms(2) mem_upI partial_object.select_convs(1))
qed
lemma(in UP_cring) UP_car_memI':
assumes "⋀x. g x ∈ carrier R"
assumes "⋀x. x > k ⟹ g x = 𝟬"
shows "g ∈ carrier (UP R)"
proof-
have "bound 𝟬 k g"
using assms unfolding bound_def by blast
then show ?thesis
using P_def UP_car_memI assms(1) by blast
qed
lemma(in UP_cring) UP_car_memE:
assumes "g ∈ carrier (UP R)"
shows "⋀x. g x ∈ carrier R"
"⋀x. x > (deg R g) ⟹ g x = 𝟬"
using P_def assms UP_def[of R] apply (simp add: mem_upD)
using assms UP_def[of R] up_def[of R]
by (smt R.ring_axioms UP_ring.deg_aboveD UP_ring.intro partial_object.select_convs(1) restrict_apply up_ring.simps(2))
end
subsection‹Lemmas About Coefficients›
context UP_ring
begin
text‹The goal here is to reduce dependence on the function coeff from Univ\_Poly, in favour of using
a polynomial itself as its coefficient function.›
lemma coeff_simp:
assumes "f ∈ carrier P"
shows "coeff (UP R) f = f "
proof fix x show "coeff (UP R) f x = f x"
using assms P_def UP_def[of R] by auto
qed
text‹Coefficients are in R›
lemma cfs_closed:
assumes "f ∈ carrier P"
shows "f n ∈ carrier R"
using assms coeff_simp[of f] P_def coeff_closed
by fastforce
lemma cfs_monom:
"a ∈ carrier R ==> (monom P a m) n = (if m=n then a else 𝟬)"
using coeff_simp P_def coeff_monom monom_closed by auto
lemma cfs_zero [simp]: "𝟬⇘P⇙ n = 𝟬"
using P_def UP_zero_closed coeff_simp coeff_zero by auto
lemma cfs_one [simp]: "𝟭⇘P⇙ n = (if n=0 then 𝟭 else 𝟬)"
by (metis P_def R.one_closed UP_ring.cfs_monom UP_ring_axioms monom_one)
lemma cfs_smult [simp]:
"[| a ∈ carrier R; p ∈ carrier P |] ==> (a ⊙⇘P⇙ p) n = a ⊗ p n"
using P_def UP_ring.coeff_simp UP_ring_axioms UP_smult_closed coeff_smult by fastforce
lemma cfs_add [simp]:
"[| p ∈ carrier P; q ∈ carrier P |] ==> (p ⊕⇘P⇙ q) n = p n ⊕ q n"
by (metis P.add.m_closed P_def UP_ring.coeff_add UP_ring.coeff_simp UP_ring_axioms)
lemma cfs_a_inv [simp]:
assumes R: "p ∈ carrier P"
shows "(⊖⇘P⇙ p) n = ⊖ (p n)"
using P.add.inv_closed P_def UP_ring.coeff_a_inv UP_ring.coeff_simp UP_ring_axioms assms
by fastforce
lemma cfs_minus [simp]:
"[| p ∈ carrier P; q ∈ carrier P |] ==> (p ⊖⇘P⇙ q) n = p n ⊖ q n"
using P.minus_closed P_def coeff_minus coeff_simp by auto
lemma cfs_monom_mult_r:
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
shows "(monom P a n ⊗⇘P⇙ p) (k + n) = a ⊗ p k"
using coeff_monom_mult assms P.m_closed P_def coeff_simp monom_closed by auto
lemma(in UP_cring) cfs_monom_mult_l:
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
shows "(p ⊗⇘P⇙ monom P a n) (k + n) = a ⊗ p k"
using UP_m_comm assms(1) assms(2) cfs_monom_mult_r by auto
lemma(in UP_cring) cfs_monom_mult_l':
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
assumes "m ≥ n"
shows "(f ⊗⇘P⇙ (monom P a n)) m = a ⊗ (f (m - n))"
using cfs_monom_mult_l[of f a n "m-n"] assms
by simp
lemma(in UP_cring) cfs_monom_mult_r':
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
assumes "m ≥ n"
shows "((monom P a n) ⊗⇘P⇙ f) m = a ⊗ (f (m - n))"
using cfs_monom_mult_r[of f a n "m-n"] assms
by simp
end
subsection‹Degree Bound Lemmas›
context UP_ring
begin
lemma bound_deg_sum:
assumes " f ∈ carrier P"
assumes "g ∈ carrier P"
assumes "degree f ≤ n"
assumes "degree g ≤ n"
shows "degree (f ⊕⇘P⇙ g) ≤ n"
using P_def UP_ring_axioms assms(1) assms(2) assms(3) assms(4)
by (meson deg_add max.boundedI order_trans)
lemma bound_deg_sum':
assumes " f ∈ carrier P"
assumes "g ∈ carrier P"
assumes "degree f < n"
assumes "degree g < n"
shows "degree (f ⊕⇘P⇙ g) < n"
using P_def UP_ring_axioms assms(1) assms(2)
assms(3) assms(4)
by (metis bound_deg_sum le_neq_implies_less less_imp_le_nat not_less)
lemma equal_deg_sum:
assumes " f ∈ carrier P"
assumes "g ∈ carrier P"
assumes "degree f < n"
assumes "degree g = n"
shows "degree (f ⊕⇘P⇙ g) = n"
proof-
have 0: "degree (f ⊕⇘P⇙ g) ≤n"
using assms bound_deg_sum
P_def UP_ring_axioms by auto
show "degree (f ⊕⇘P⇙ g) = n"
proof(rule ccontr)
assume "degree (f ⊕⇘P⇙ g) ≠ n "
then have 1: "degree (f ⊕⇘P⇙ g) < n"
using 0 by auto
have 2: "degree (⊖⇘P⇙ f) < n"
using assms by simp
have 3: "g = (f ⊕⇘P⇙ g) ⊕⇘P⇙ (⊖⇘P⇙ f)"
using assms
by (simp add: P.add.m_comm P.r_neg1)
then show False using 1 2 3 assms
by (metis UP_a_closed UP_a_inv_closed deg_add leD le_max_iff_disj)
qed
qed
lemma equal_deg_sum':
assumes "f ∈ carrier P"
assumes "g ∈ carrier P"
assumes "degree g < n"
assumes "degree f = n"
shows "degree (f ⊕⇘P⇙ g) = n"
using P_def UP_a_comm UP_ring.equal_deg_sum UP_ring_axioms assms(1) assms(2) assms(3) assms(4)
by fastforce
lemma degree_of_sum_diff_degree:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "degree q < degree p"
shows "degree (p ⊕⇘P⇙ q) = degree p"
by(rule equal_deg_sum', auto simp: assms)
lemma degree_of_difference_diff_degree:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "degree q < degree p"
shows "degree (p ⊖⇘P⇙ q) = degree p"
proof-
have A: "(p ⊖⇘P⇙ q) = p ⊕⇘P⇙ (⊖⇘P⇙ q)"
by (simp add: P.minus_eq)
have "degree (⊖⇘P⇙ q) = degree q "
by (simp add: assms(2))
then show ?thesis
using assms A
by (simp add: degree_of_sum_diff_degree)
qed
lemma (in UP_ring) deg_diff_by_const:
assumes "g ∈ carrier (UP R)"
assumes "a ∈ carrier R"
assumes "h = g ⊕⇘UP R⇙ up_ring.monom (UP R) a 0"
shows "deg R g = deg R h"
unfolding assms using assms
by (metis P_def UP_ring.bound_deg_sum UP_ring.deg_monom_le UP_ring.monom_closed UP_ring_axioms degree_of_sum_diff_degree gr_zeroI not_less)
lemma (in UP_ring) deg_diff_by_const':
assumes "g ∈ carrier (UP R)"
assumes "a ∈ carrier R"
assumes "h = g ⊖⇘UP R⇙ up_ring.monom (UP R) a 0"
shows "deg R g = deg R h"
apply(rule deg_diff_by_const[of _ "⊖ a"])
using assms apply blast
using assms apply blast
by (metis P.minus_eq P_def assms(2) assms(3) monom_a_inv)
lemma(in UP_ring) deg_gtE:
assumes "p ∈ carrier P"
assumes "i > deg R p"
shows "p i = 𝟬"
using assms P_def coeff_simp deg_aboveD by metis
end
subsection‹Leading Term Function›
definition leading_term where
"leading_term R f = monom (UP R) (f (deg R f)) (deg R f)"
context UP_ring
begin
abbreviation(input) ltrm where
"ltrm f ≡ monom P (f (deg R f)) (deg R f)"
text‹leading term is a polynomial›
lemma ltrm_closed:
assumes "f ∈ carrier P"
shows "ltrm f ∈ carrier P"
using assms
by (simp add: cfs_closed)
text‹Simplified coefficient function description for leading term›
lemma ltrm_coeff:
assumes "f ∈ carrier P"
shows "coeff P (ltrm f) n = (if (n = degree f) then (f (degree f)) else 𝟬)"
using assms
by (simp add: cfs_closed)
lemma ltrm_cfs:
assumes "f ∈ carrier P"
shows "(ltrm f) n = (if (n = degree f) then (f (degree f)) else 𝟬)"
using assms
by (simp add: cfs_closed cfs_monom)
lemma ltrm_cfs_above_deg:
assumes "f ∈ carrier P"
assumes "n > degree f"
shows "ltrm f n = 𝟬"
using assms
by (simp add: ltrm_cfs)
text‹The leading term of f has the same degree as f›
lemma deg_ltrm:
assumes "f ∈ carrier P"
shows "degree (ltrm f) = degree f"
using assms
by (metis P_def UP_ring.lcoeff_nonzero_deg UP_ring_axioms cfs_closed coeff_simp deg_const deg_monom)
text‹Subtracting the leading term yields a drop in degree›
lemma minus_ltrm_degree_drop:
assumes "f ∈ carrier P"
assumes "degree f = Suc n"
shows "degree (f ⊖⇘P⇙ (ltrm f)) ≤ n"
proof(rule UP_ring.deg_aboveI)
show C0: "UP_ring R"
by (simp add: UP_ring_axioms)
show C1: "f ⊖⇘P⇙ ltrm f ∈ carrier (UP R)"
using assms ltrm_closed P.minus_closed P_def
by blast
show C2: "⋀m. n < m ⟹ coeff (UP R) (f ⊖⇘P⇙ ltrm f) m = 𝟬"
proof-
fix m
assume A: "n<m"
show "coeff (UP R) (f ⊖⇘P⇙ ltrm f) m = 𝟬"
proof(cases " m = Suc n")
case True
have B: "f m ∈ carrier R"
using UP.coeff_closed P_def assms(1) cfs_closed by blast
have "m = degree f"
using True by (simp add: assms(2))
then have "f m = (ltrm f) m"
using ltrm_cfs assms(1) by auto
then have "(f m) ⊖⇘R⇙( ltrm f) m = 𝟬"
using B UP_ring_def P_is_UP_ring
B R.add.r_inv R.is_abelian_group abelian_group.minus_eq by fastforce
then have "(f ⊖⇘UP R⇙ ltrm f) m = 𝟬"
by (metis C1 ltrm_closed P_def assms(1) coeff_minus coeff_simp)
then show ?thesis
using C1 P_def UP_ring.coeff_simp UP_ring_axioms by fastforce
next
case False
have D0: "m > degree f" using False
using A assms(2) by linarith
have B: "f m ∈ carrier R"
using UP.coeff_closed P_def assms(1) cfs_closed
by blast
have "f m = (ltrm f) m"
using D0 ltrm_cfs_above_deg P_def assms(1) coeff_simp deg_aboveD
by auto
then show ?thesis
by (metis B ltrm_closed P_def R.r_neg UP_ring.coeff_simp UP_ring_axioms a_minus_def assms(1) coeff_minus)
qed
qed
qed
lemma ltrm_decomp:
assumes "f ∈ carrier P"
assumes "degree f >(0::nat)"
obtains g where "g ∈ carrier P ∧ f = g ⊕⇘P⇙ (ltrm f) ∧ degree g < degree f"
proof-
have 0: "f ⊖⇘P⇙ (ltrm f) ∈ carrier P"
using ltrm_closed assms(1) by blast
have 1: "f = (f ⊖⇘P⇙ (ltrm f)) ⊕⇘P⇙ (ltrm f)"
using assms
by (metis "0" ltrm_closed P.add.inv_solve_right P.minus_eq)
show ?thesis using assms 0 1 minus_ltrm_degree_drop[of f]
by (metis ltrm_closed Suc_diff_1 Suc_n_not_le_n deg_ltrm equal_deg_sum' linorder_neqE_nat that)
qed
text‹leading term of a sum›
lemma coeff_of_sum_diff_degree0:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "degree q < n"
shows "(p ⊕⇘P⇙ q) n = p n"
using assms P_def UP_ring.deg_aboveD UP_ring_axioms cfs_add coeff_simp cfs_closed deg_aboveD
by auto
lemma coeff_of_sum_diff_degree1:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "degree q < degree p"
shows "(p ⊕⇘P⇙ q) (degree p) = p (degree p)"
using assms(1) assms(2) assms(3) coeff_of_sum_diff_degree0 by blast
lemma ltrm_of_sum_diff_degree:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "degree p > degree q"
shows "ltrm (p ⊕⇘P⇙ q) = ltrm p"
unfolding leading_term_def
using assms(1) assms(2) assms(3) coeff_of_sum_diff_degree1 degree_of_sum_diff_degree
by presburger
text‹leading term of a monomial›
lemma ltrm_monom:
assumes "a ∈ carrier R"
assumes "f = monom P a n"
shows "ltrm f = f"
unfolding leading_term_def
by (metis P_def UP_ring.cfs_monom UP_ring.monom_zero UP_ring_axioms assms(1) assms(2) deg_monom)
lemma ltrm_monom_simp:
assumes "a ∈ carrier R"
shows "ltrm (monom P a n) = monom P a n"
using assms ltrm_monom by auto
lemma ltrm_inv_simp[simp]:
assumes "f ∈ carrier P"
shows "ltrm (ltrm f) = ltrm f"
by (metis assms deg_ltrm ltrm_cfs)
lemma ltrm_deg_0:
assumes "p ∈ carrier P"
assumes "degree p = 0"
shows "ltrm p = p"
using ltrm_monom assms P_def UP_ring.deg_zero_impl_monom UP_ring_axioms coeff_simp
by fastforce
lemma ltrm_prod_ltrm:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
shows "ltrm ((ltrm p) ⊗⇘P⇙ (ltrm q)) = (ltrm p) ⊗⇘P⇙ (ltrm q)"
using ltrm_monom R.m_closed assms(1) assms(2) cfs_closed monom_mult
by metis
text‹lead coefficient function›
abbreviation(input) lcf where
"lcf p ≡ p (deg R p)"
lemma(in UP_ring) lcf_ltrm:
"ltrm p = monom P (lcf p) (degree p)"
by auto
lemma lcf_closed:
assumes "f ∈ carrier P"
shows "lcf f ∈ carrier R"
by (simp add: assms cfs_closed)
lemma(in UP_cring) lcf_monom:
assumes "a ∈ carrier R"
shows "lcf (monom P a n) = a" "lcf (monom (UP R) a n) = a"
using assms deg_monom cfs_monom apply fastforce
by (metis UP_ring.cfs_monom UP_ring.deg_monom UP_ring_axioms assms)
end
text‹Function which truncates a polynomial by removing the leading term›
definition truncate where
"truncate R f = f ⊖⇘(UP R)⇙ (leading_term R f)"
context UP_ring
begin
abbreviation(input) trunc where
"trunc ≡ truncate R"
lemma trunc_closed:
assumes "f ∈ carrier P"
shows "trunc f ∈ carrier P"
using assms unfolding truncate_def
by (metis ltrm_closed P_def UP_ring.UP_ring UP_ring_axioms leading_term_def ring.ring_simprules(4))
lemma trunc_simps:
assumes "f ∈ carrier P"
shows "f = (trunc f) ⊕⇘P⇙ (ltrm f)"
"f ⊖⇘P⇙ (trunc f) = ltrm f"
apply (metis ltrm_closed P.add.inv_solve_right P.minus_closed P_def a_minus_def assms Cring_Poly.truncate_def leading_term_def)
using trunc_closed[of f] ltrm_closed[of f] P_def P.add.inv_solve_right[of "ltrm f" f "trunc f"]
assms unfolding UP_cring_def
by (metis P.add.inv_closed P.add.m_lcomm P.add.r_inv_ex P.minus_eq P.minus_minus
P.r_neg2 P.r_zero Cring_Poly.truncate_def leading_term_def)
lemma trunc_zero:
assumes "f ∈ carrier P"
assumes "degree f = 0"
shows "trunc f = 𝟬⇘P⇙"
unfolding truncate_def
using assms ltrm_deg_0[of f]
by (metis P.r_neg P_def a_minus_def leading_term_def)
lemma trunc_degree:
assumes "f ∈ carrier P"
assumes "degree f > 0"
shows "degree (trunc f) < degree f"
unfolding truncate_def using assms
by (metis ltrm_closed ltrm_decomp P.add.right_cancel Cring_Poly.truncate_def trunc_closed trunc_simps(1))
text‹The coefficients of trunc agree with f for small degree›
lemma trunc_cfs:
assumes "p ∈ carrier P"
assumes "n < degree p"
shows " (trunc p) n = p n"
using P_def assms(1) assms(2) unfolding truncate_def
by (smt ltrm_closed ltrm_cfs R.minus_zero R.ring_axioms UP_ring.cfs_minus
UP_ring_axioms a_minus_def cfs_closed leading_term_def nat_neq_iff ring.ring_simprules(15))
text‹monomial predicate›
definition is_UP_monom where
"is_UP_monom = (λf. f ∈ carrier (UP R) ∧ f = ltrm f)"
lemma is_UP_monomI:
assumes "a ∈ carrier R"
assumes "p = monom P a n"
shows "is_UP_monom p"
using assms(1) assms(2) is_UP_monom_def ltrm_monom P_def monom_closed
by auto
lemma is_UP_monomI':
assumes "f ∈ carrier (UP R)"
assumes "f = ltrm f"
shows "is_UP_monom f"
using assms P_def unfolding is_UP_monom_def by blast
lemma monom_is_UP_monom:
assumes "a ∈ carrier R"
shows "is_UP_monom (monom P a n)" "is_UP_monom (monom (UP R) a n)"
using assms P_def ltrm_monom_simp monom_closed
unfolding is_UP_monom_def
by auto
lemma is_UP_monomE:
assumes "is_UP_monom f"
shows "f ∈ carrier P" "f = monom P (lcf f) (degree f)" "f = monom (UP R) (lcf f) (degree f)"
using assms unfolding is_UP_monom_def
by(auto simp: P_def )
lemma ltrm_is_UP_monom:
assumes "p ∈ carrier P"
shows "is_UP_monom (ltrm p)"
using assms
by (simp add: cfs_closed monom_is_UP_monom(1))
lemma is_UP_monom_mult:
assumes "is_UP_monom p"
assumes "is_UP_monom q"
shows "is_UP_monom (p ⊗⇘P⇙ q)"
apply(rule is_UP_monomI')
using assms is_UP_monomE P_def UP_mult_closed
apply simp
using assms is_UP_monomE[of p] is_UP_monomE[of q]
P_def monom_mult
by (metis lcf_closed ltrm_monom R.m_closed)
end
subsection‹Properties of Leading Terms and Leading Coefficients in Commutative Rings and Domains›
context UP_cring
begin
lemma cring_deg_mult:
assumes "q ∈ carrier P"
assumes "p ∈ carrier P"
assumes "lcf q ⊗ lcf p ≠𝟬"
shows "degree (q ⊗⇘P⇙ p) = degree p + degree q"
proof-
have "q ⊗⇘P⇙ p = (trunc q ⊕⇘P⇙ ltrm q) ⊗⇘P⇙ (trunc p ⊕⇘P⇙ ltrm p)"
using assms(1) assms(2) trunc_simps(1) by auto
then have "q ⊗⇘P⇙ p = (trunc q ⊕⇘P⇙ ltrm q) ⊗⇘P⇙ (trunc p ⊕⇘P⇙ ltrm p)"
by linarith
then have 0: "q ⊗⇘P⇙ p = (trunc q ⊗⇘P⇙ (trunc p ⊕⇘P⇙ ltrm p)) ⊕⇘P⇙ ( ltrm q ⊗⇘P⇙ (trunc p ⊕⇘P⇙ ltrm p))"
by (simp add: P.l_distr assms(1) assms(2) ltrm_closed trunc_closed)
have 1: "(trunc q ⊗⇘P⇙ (trunc p ⊕⇘P⇙ ltrm p)) (degree p + degree q) = 𝟬"
proof(cases "degree q = 0")
case True
then show ?thesis
using assms(1) assms(2) trunc_simps(1) trunc_zero by auto
next
case False
have "degree ((trunc q) ⊗⇘P⇙ p) ≤ degree (trunc q) + degree p"
using assms trunc_simps[of q] deg_mult_ring[of "trunc q" p] trunc_closed
by blast
then have "degree (trunc q ⊗⇘P⇙ (trunc p ⊕⇘P⇙ ltrm p)) < degree q + degree p"
using False assms(1) assms(2) trunc_degree trunc_simps(1) by fastforce
then show ?thesis
by (metis P_def UP_mult_closed UP_ring.coeff_simp UP_ring_axioms
add.commute assms(1) assms(2) deg_belowI not_less trunc_closed trunc_simps(1))
qed
have 2: "(q ⊗⇘P⇙ p) (degree p + degree q) =
( ltrm q ⊗⇘P⇙ (trunc p ⊕⇘P⇙ ltrm p)) (degree p + degree q)"
using 0 1 assms cfs_closed trunc_closed by auto
have 3: "(q ⊗⇘P⇙ p) (degree p + degree q) =
( ltrm q ⊗⇘P⇙ trunc p) (degree p + degree q) ⊕ ( ltrm q ⊗⇘P⇙ ltrm p) (degree p + degree q)"
by (simp add: "2" ltrm_closed UP_r_distr assms(1) assms(2) trunc_closed)
have 4: "( ltrm q ⊗⇘P⇙ trunc p) (degree p + degree q) = 𝟬"
proof(cases "degree p = 0")
case True
then show ?thesis
using "2" "3" assms(1) assms(2) cfs_closed ltrm_closed trunc_zero by auto
next
case False
have "degree ( ltrm q ⊗⇘P⇙ trunc p) ≤ degree (ltrm q) + degree (trunc p)"
using assms trunc_simps deg_mult_ring ltrm_closed trunc_closed by presburger
then have "degree ( ltrm q ⊗⇘P⇙ trunc p) < degree q + degree p"
using False assms(1) assms(2) trunc_degree trunc_simps(1) deg_ltrm by fastforce
then show ?thesis
by (metis ltrm_closed P_def UP_mult_closed UP_ring.coeff_simp UP_ring_axioms add.commute assms(1) assms(2) deg_belowI not_less trunc_closed)
qed
have 5: "(q ⊗⇘P⇙ p) (degree p + degree q) = ( ltrm q ⊗⇘P⇙ ltrm p) (degree p + degree q)"
by (simp add: "3" "4" assms(1) assms(2) cfs_closed)
have 6: "ltrm q ⊗⇘P⇙ ltrm p = monom P (lcf q ⊗ lcf p) (degree p + degree q)"
unfolding leading_term_def
by (metis P_def UP_ring.monom_mult UP_ring_axioms add.commute assms(1) assms(2) cfs_closed)
have 7: "( ltrm q ⊗⇘P⇙ ltrm p) (degree p + degree q) ≠𝟬"
using 5 6 assms
by (metis R.m_closed cfs_closed cfs_monom)
have 8: "degree (q ⊗⇘P⇙ p) ≥degree p + degree q"
using 5 6 7 P_def UP_mult_closed assms(1) assms(2)
by (simp add: UP_ring.coeff_simp UP_ring_axioms deg_belowI)
then show ?thesis
using assms(1) assms(2) deg_mult_ring by fastforce
qed
text‹leading term is multiplicative›
lemma ltrm_of_sum_diff_deg:
assumes "q ∈ carrier P"
assumes "a ∈ carrier R"
assumes "a ≠𝟬"
assumes "degree q < n"
assumes "p = q ⊕⇘P⇙ (monom P a n)"
shows "ltrm p = (monom P a n)"
proof-
have 0: "degree (monom P a n) = n"
by (simp add: assms(2) assms(3))
have 1: "(monom P a n) ∈ carrier P"
using assms(2) by auto
have 2: "ltrm ((monom P a n) ⊕⇘P⇙ q) = ltrm (monom P a n)"
using assms ltrm_of_sum_diff_degree[of "(monom P a n)" q] 1 "0" by linarith
then show ?thesis
using UP_a_comm assms(1) assms(2) assms(5) ltrm_monom by auto
qed
lemma(in UP_cring) ltrm_smult_cring:
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
assumes "lcf p ⊗ a ≠ 𝟬"
shows "ltrm (a ⊙⇘P⇙p) = a⊙⇘P⇙(ltrm p)"
using assms
by (smt lcf_monom(1) P_def R.m_closed R.m_comm cfs_closed cfs_smult coeff_simp
cring_deg_mult deg_monom deg_ltrm monom_closed monom_mult_is_smult monom_mult_smult)
lemma(in UP_cring) deg_zero_ltrm_smult_cring:
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
assumes "degree p = 0"
shows "ltrm (a ⊙⇘P⇙p) = a⊙⇘P⇙(ltrm p)"
by (metis ltrm_deg_0 assms(1) assms(2) assms(3) deg_smult_decr le_0_eq module.smult_closed module_axioms)
lemma(in UP_domain) ltrm_smult:
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
shows "ltrm (a ⊙⇘P⇙p) = a⊙⇘P⇙(ltrm p)"
by (metis lcf_closed ltrm_closed ltrm_smult_cring P_def R.integral_iff UP_ring.deg_ltrm
UP_ring_axioms UP_smult_zero assms(1) assms(2) cfs_zero deg_nzero_nzero deg_zero_ltrm_smult_cring monom_zero)
lemma(in UP_cring) cring_ltrm_mult:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "lcf p ⊗ lcf q ≠ 𝟬"
shows "ltrm (p ⊗⇘P⇙ q) = (ltrm p) ⊗⇘P⇙ (ltrm q)"
proof(cases "degree p = 0 ∨ degree q = 0")
case True
then show ?thesis
by (smt ltrm_closed ltrm_deg_0 ltrm_smult_cring R.m_comm UP_m_comm assms(1) assms(2) assms(3) cfs_closed monom_mult_is_smult)
next
case False
obtain q0 where q0_def: "q0 = trunc q"
by simp
obtain p0 where p0_def: "p0 = trunc p"
by simp
have Pq: "degree q0 < degree q"
using False P_def assms(2) q0_def trunc_degree by blast
have Pp: "degree p0 < degree p"
using False P_def assms(1) p0_def trunc_degree by blast
have "p ⊗⇘P⇙ q = (p0 ⊕⇘P⇙ ltrm(p)) ⊗⇘P ⇙(q0 ⊕⇘P⇙ ltrm(q))"
using assms(1) assms(2) p0_def q0_def trunc_simps(1) by auto
then have P0: "p ⊗⇘P⇙ q = ((p0 ⊕⇘P⇙ ltrm(p)) ⊗⇘P ⇙q0) ⊕⇘P⇙ ((p0 ⊕⇘P⇙ ltrm(p))⊗⇘P ⇙ltrm(q))"
by (simp add: P.r_distr assms(1) assms(2) ltrm_closed p0_def q0_def trunc_closed)
have P1: "degree ((p0 ⊕⇘P⇙ ltrm(p)) ⊗⇘P ⇙q0) < degree ((p0 ⊕⇘P⇙ ltrm(p))⊗⇘P ⇙ltrm(q))"
proof-
have LHS: "degree ((p0 ⊕⇘P⇙ ltrm(p)) ⊗⇘P ⇙q0) ≤ degree p + degree q0 "
proof(cases "q0 = 𝟬⇘P⇙")
case True
then show ?thesis
using assms(1) p0_def trunc_simps(1) by auto
next
case False
then show ?thesis
using assms(1) assms(2) deg_mult_ring p0_def
q0_def trunc_simps(1) trunc_closed by auto
qed
have RHS: "degree ((p0 ⊕⇘P⇙ ltrm(p))⊗⇘P ⇙ltrm(q)) = degree p + degree q"
using assms(1) assms(2) deg_mult_ring ltrm_closed p0_def trunc_simps(1)
by (smt P_def UP_cring.lcf_monom(1) UP_cring.cring_deg_mult UP_cring_axioms add.commute assms(3) cfs_closed deg_ltrm)
then show ?thesis
using RHS LHS Pq
by linarith
qed
then have P2: "ltrm (p ⊗⇘P⇙ q) = ltrm ((p0 ⊕⇘P⇙ ltrm(p))⊗⇘P ⇙ltrm(q))"
using P0 P1
by (metis (no_types, lifting) ltrm_closed ltrm_of_sum_diff_degree P.add.m_comm
UP_mult_closed assms(1) assms(2) p0_def q0_def trunc_closed trunc_simps(1))
have P3: " ltrm ((p0 ⊕⇘P⇙ ltrm(p))⊗⇘P ⇙ltrm(q)) = ltrm p ⊗⇘P⇙ ltrm q"
proof-
have Q0: "((p0 ⊕⇘P⇙ ltrm(p))⊗⇘P ⇙ltrm(q)) = (p0 ⊗⇘P ⇙ltrm(q)) ⊕⇘P⇙ (ltrm(p))⊗⇘P ⇙ltrm(q)"
by (simp add: P.l_distr assms(1) assms(2) ltrm_closed p0_def trunc_closed)
have Q1: "degree ((p0 ⊗⇘P ⇙ltrm(q)) ) < degree ((ltrm(p))⊗⇘P ⇙ltrm(q))"
proof(cases "p0 = 𝟬⇘P⇙")
case True
then show ?thesis
using P1 assms(1) assms(2) ltrm_closed by auto
next
case F: False
then show ?thesis
proof-
have LHS: "degree ((p0 ⊗⇘P ⇙ltrm(q))) < degree p + degree q"
using False F Pp assms(1) assms(2) deg_nzero_nzero
deg_ltrm ltrm_closed p0_def trunc_closed
by (smt add_le_cancel_right deg_mult_ring le_trans not_less)
have RHS: "degree ((ltrm(p))⊗⇘P ⇙ltrm(q)) = degree p + degree q"
using cring_deg_mult[of "ltrm p" "ltrm q"] assms
by (simp add: ltrm_closed ltrm_cfs deg_ltrm)
then show ?thesis using LHS RHS by auto
qed
qed
have Q2: "ltrm ((p0 ⊕⇘P⇙ ltrm(p))⊗⇘P ⇙ltrm(q)) = ltrm ((ltrm(p))⊗⇘P ⇙ltrm(q))"
using Q0 Q1
by (metis (no_types, lifting) ltrm_closed ltrm_of_sum_diff_degree P.add.m_comm
UP_mult_closed assms(1) assms(2) p0_def trunc_closed)
show ?thesis using ltrm_prod_ltrm Q0 Q1 Q2
by (simp add: assms(1) assms(2))
qed
then show ?thesis
by (simp add: P2)
qed
lemma(in UP_domain) ltrm_mult:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
shows "ltrm (p ⊗⇘P⇙ q) = (ltrm p) ⊗⇘P⇙ (ltrm q)"
using cring_ltrm_mult assms
by (smt ltrm_closed ltrm_deg_0 cfs_closed deg_nzero_nzero deg_ltrm local.integral_iff monom_mult monom_zero)
lemma lcf_deg_0:
assumes "degree p = 0"
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
shows "(p ⊗⇘P⇙ q) = (lcf p)⊙⇘P⇙q"
using P_def assms(1) assms(2) assms(3)
by (metis ltrm_deg_0 cfs_closed monom_mult_is_smult)
text‹leading term powers›
lemma (in domain) nonzero_pow_nonzero:
assumes "a ∈ carrier R"
assumes "a ≠𝟬"
shows "a[^](n::nat) ≠ 𝟬"
proof(induction n)
case 0
then show ?case
by auto
next
case (Suc n)
fix n::nat
assume IH: "a[^] n ≠ 𝟬"
show "a[^] (Suc n) ≠ 𝟬"
proof-
have "a[^] (Suc n) = a[^] n ⊗ a"
by simp
then show ?thesis using assms IH
using IH assms(1) assms(2) local.integral by auto
qed
qed
lemma (in UP_cring) cring_monom_degree:
assumes "a ∈ (carrier R)"
assumes "p = monom P a m"
assumes "a[^]n ≠ 𝟬"
shows "degree (p[^]⇘P⇙ n) = n*m"
by (simp add: assms(1) assms(2) assms(3) monom_pow)
lemma (in UP_domain) monom_degree:
assumes "a ≠𝟬"
assumes "a ∈ (carrier R)"
assumes "p = monom P a m"
shows "degree (p[^]⇘P⇙ n) = n*m"
by (simp add: R.domain_axioms assms(1) assms(2) assms(3) domain.nonzero_pow_nonzero monom_pow)
lemma(in UP_cring) cring_pow_ltrm:
assumes "p ∈ carrier P"
assumes "lcf p [^]n ≠ 𝟬"
shows "ltrm (p[^]⇘P⇙(n::nat)) = (ltrm p)[^]⇘P⇙n"
proof-
have "lcf p [^]n ≠ 𝟬 ⟹ ltrm (p[^]⇘P⇙(n::nat)) = (ltrm p)[^]⇘P⇙n"
proof(induction n)
case 0
then show ?case
using P.ring_simprules(6) P.nat_pow_0 cfs_one deg_one monom_one by presburger
next
case (Suc n) fix n::nat
assume IH : "(lcf p [^] n ≠ 𝟬 ⟹ ltrm (p [^]⇘P⇙ n) = ltrm p [^]⇘P⇙ n)"
assume A: "lcf p [^] Suc n ≠ 𝟬"
have a: "ltrm (p [^]⇘P⇙ n) = ltrm p [^]⇘P⇙ n"
apply(cases "lcf p [^] n = 𝟬")
using A lcf_closed assms(1) apply auto[1]
by(rule IH)
have 0: "lcf (ltrm (p [^]⇘P⇙ n)) = lcf p [^] n"
unfolding a
by (simp add: lcf_monom(1) assms(1) cfs_closed monom_pow)
then have 1: "lcf (ltrm (p [^]⇘P⇙ n)) ⊗ lcf p ≠ 𝟬"
using assms A R.nat_pow_Suc IH by metis
then show "ltrm (p [^]⇘P⇙ Suc n) = ltrm p [^]⇘P⇙ Suc n"
using IH 0 assms(1) cring_ltrm_mult cfs_closed
by (smt A lcf_monom(1) ltrm_closed P.nat_pow_Suc2 P.nat_pow_closed R.nat_pow_Suc2 a)
qed
then show ?thesis
using assms(2) by blast
qed
lemma(in UP_cring) cring_pow_deg:
assumes "p ∈ carrier P"
assumes "lcf p [^]n ≠ 𝟬"
shows "degree (p[^]⇘P⇙(n::nat)) = n*degree p"
proof-
have "degree ( (ltrm p)[^]⇘P⇙n) = n*degree p"
using assms(1) assms(2) cring_monom_degree lcf_closed lcf_ltrm by auto
then show ?thesis
using assms cring_pow_ltrm
by (metis P.nat_pow_closed P_def UP_ring.deg_ltrm UP_ring_axioms)
qed
lemma(in UP_cring) cring_pow_deg_bound:
assumes "p ∈ carrier P"
shows "degree (p[^]⇘P⇙(n::nat)) ≤ n*degree p"
apply(induction n)
apply (metis Group.nat_pow_0 deg_one le_zero_eq mult_is_0)
using deg_mult_ring[of _ p]
by (smt P.nat_pow_Suc2 P.nat_pow_closed ab_semigroup_add_class.add_ac(1) assms deg_mult_ring le_iff_add mult_Suc)
lemma(in UP_cring) deg_smult:
assumes "a ∈ carrier R"
assumes "f ∈ carrier (UP R)"
assumes "a ⊗ lcf f ≠ 𝟬"
shows "deg R (a ⊙⇘UP R⇙ f) = deg R f"
using assms P_def cfs_smult deg_eqI deg_smult_decr smult_closed
by (metis deg_gtE le_neq_implies_less)
lemma(in UP_cring) deg_smult':
assumes "a ∈ Units R"
assumes "f ∈ carrier (UP R)"
shows "deg R (a ⊙⇘UP R⇙ f) = deg R f"
apply(cases "deg R f = 0")
apply (metis P_def R.Units_closed assms(1) assms(2) deg_smult_decr le_zero_eq)
apply(rule deg_smult)
using assms apply blast
using assms apply blast
proof
assume A: "deg R f ≠ 0" "a ⊗ f (deg R f) = 𝟬"
have 0: "f (deg R f) = 𝟬"
using A assms R.Units_not_right_zero_divisor[of a "f (deg R f)"] UP_car_memE(1) by blast
then show False using assms A
by (metis P_def deg_zero deg_ltrm monom_zero)
qed
lemma(in UP_domain) pow_sum0:
"⋀ p q. p ∈ carrier P ⟹ q ∈ carrier P ⟹ degree q < degree p ⟹ degree ((p ⊕⇘P⇙ q )[^]⇘P⇙n) = (degree p)*n"
proof(induction n)
case 0
then show ?case
by (metis Group.nat_pow_0 deg_one mult_is_0)
next
case (Suc n)
fix n
assume IH: "⋀ p q. p ∈ carrier P ⟹ q ∈ carrier P ⟹
degree q < degree p ⟹ degree ((p ⊕⇘P⇙ q )[^]⇘P⇙n) = (degree p)*n"
then show "⋀ p q. p ∈ carrier P ⟹ q ∈ carrier P ⟹
degree q < degree p ⟹ degree ((p ⊕⇘P⇙ q )[^]⇘P⇙(Suc n)) = (degree p)*(Suc n)"
proof-
fix p q
assume A0: "p ∈ carrier P" and
A1: "q ∈ carrier P" and
A2: "degree q < degree p"
show "degree ((p ⊕⇘P⇙ q )[^]⇘P⇙(Suc n)) = (degree p)*(Suc n)"
proof(cases "q = 𝟬⇘P⇙")
case True
then show ?thesis
by (metis A0 A1 A2 IH P.nat_pow_Suc2 P.nat_pow_closed P.r_zero deg_mult
domain.nonzero_pow_nonzero local.domain_axioms mult_Suc_right nat_neq_iff)
next
case False
then show ?thesis
proof-
have P0: "degree ((p ⊕⇘P⇙ q )[^]⇘P⇙n) = (degree p)*n"
using A0 A1 A2 IH by auto
have P1: "(p ⊕⇘P⇙ q )[^]⇘P⇙(Suc n) = ((p ⊕⇘P⇙ q )[^]⇘P⇙n) ⊗⇘P⇙ (p ⊕⇘P⇙ q )"
by simp
then have P2: "(p ⊕⇘P⇙ q )[^]⇘P⇙(Suc n) = (((p ⊕⇘P⇙ q )[^]⇘P⇙n) ⊗⇘P⇙ p) ⊕⇘P⇙ (((p ⊕⇘P⇙ q )[^]⇘P⇙n) ⊗⇘P⇙ q)"
by (simp add: A0 A1 UP_r_distr)
have P3: "degree (((p ⊕⇘P⇙ q )[^]⇘P⇙n) ⊗⇘P⇙ p) = (degree p)*n + (degree p)"
using P0 A0 A1 A2 deg_nzero_nzero degree_of_sum_diff_degree local.nonzero_pow_nonzero by auto
have P4: "degree (((p ⊕⇘P⇙ q )[^]⇘P⇙n) ⊗⇘P⇙ q) = (degree p)*n + (degree q)"
using P0 A0 A1 A2 deg_nzero_nzero degree_of_sum_diff_degree local.nonzero_pow_nonzero False deg_mult
by simp
have P5: "degree (((p ⊕⇘P⇙ q )[^]⇘P⇙n) ⊗⇘P⇙ p) > degree (((p ⊕⇘P⇙ q )[^]⇘P⇙n) ⊗⇘P⇙ q)"
using P3 P4 A2 by auto
then show ?thesis using P5 P3 P2
by (simp add: A0 A1 degree_of_sum_diff_degree)
qed
qed
qed
qed
lemma(in UP_domain) pow_sum:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "degree q < degree p"
shows "degree ((p ⊕⇘P⇙ q )[^]⇘P⇙n) = (degree p)*n"
using assms(1) assms(2) assms(3) pow_sum0 by blast
lemma(in UP_domain) deg_pow0:
"⋀ p. p ∈ carrier P ⟹ n ≥ degree p ⟹ degree (p [^]⇘P⇙ m) = m*(degree p)"
proof(induction n)
case 0
show "p ∈ carrier P ⟹ 0 ≥ degree p ⟹ degree (p [^]⇘P⇙ m) = m*(degree p)"
proof-
assume B0:"p ∈ carrier P"
assume B1: "0 ≥ degree p"
then obtain a where a_def: "a ∈ carrier R ∧ p = monom P a 0"
using B0 deg_zero_impl_monom by fastforce
show "degree (p [^]⇘P⇙ m) = m*(degree p)" using UP_cring.monom_pow
by (metis P_def R.nat_pow_closed UP_cring_axioms a_def deg_const
mult_0_right mult_zero_left)
qed
next
case (Suc n)
fix n
assume IH: "⋀p. (p ∈ carrier P ⟹ n ≥degree p ⟹ degree (p [^]⇘P⇙ m) = m * (degree p))"
show "p ∈ carrier P ⟹ Suc n ≥ degree p ⟹ degree (p [^]⇘P⇙ m) = m * (degree p)"
proof-
assume A0: "p ∈ carrier P"
assume A1: "Suc n ≥ degree p"
show "degree (p [^]⇘P⇙ m) = m * (degree p)"
proof(cases "Suc n > degree p")
case True
then show ?thesis using IH A0 by simp
next
case False
then show ?thesis
proof-
obtain q where q_def: "q = trunc p"
by simp
obtain k where k_def: "k = degree q"
by simp
have q_is_poly: "q ∈ carrier P"
by (simp add: A0 q_def trunc_closed)
have k_bound0: "k <degree p"
using k_def q_def trunc_degree[of p] A0 False by auto
have k_bound1: "k ≤ n"
using k_bound0 A0 A1 by auto
have P_q:"degree (q [^]⇘P⇙ m) = m * k"
using IH[of "q"] k_bound1 k_def q_is_poly by auto
have P_ltrm: "degree ((ltrm p) [^]⇘P⇙ m) = m*(degree p)"
proof-
have "degree p = degree (ltrm p)"
by (simp add: A0 deg_ltrm)
then show ?thesis using monom_degree
by (metis A0 P.r_zero P_def cfs_closed coeff_simp equal_deg_sum k_bound0 k_def lcoeff_nonzero2 nat_neq_iff q_is_poly)
qed
have "p = q ⊕⇘P⇙ (ltrm p)"
by (simp add: A0 q_def trunc_simps(1))
then show ?thesis
using P_q pow_sum[of "(ltrm p)" q m] A0 UP_a_comm
deg_ltrm k_bound0 k_def ltrm_closed q_is_poly by auto
qed
qed
qed
qed
lemma(in UP_domain) deg_pow:
assumes "p ∈ carrier P"
shows "degree (p [^]⇘P⇙ m) = m*(degree p)"
using deg_pow0 assms by blast
lemma(in UP_domain) ltrm_pow0:
"⋀f. f ∈ carrier P ⟹ ltrm (f [^]⇘P⇙ (n::nat)) = (ltrm f) [^]⇘P⇙ n"
proof(induction n)
case 0
then show ?case
using ltrm_deg_0 P.nat_pow_0 P.ring_simprules(6) deg_one by presburger
next
case (Suc n)
fix n::nat
assume IH: "⋀f. f ∈ carrier P ⟹ ltrm (f [^]⇘P⇙ n) = (ltrm f) [^]⇘P⇙ n"
then show "⋀f. f ∈ carrier P ⟹ ltrm (f [^]⇘P⇙ (Suc n)) = (ltrm f) [^]⇘P⇙ (Suc n)"
proof-
fix f
assume A: "f ∈ carrier P"
show " ltrm (f [^]⇘P⇙ (Suc n)) = (ltrm f) [^]⇘P⇙ (Suc n)"
proof-
have 0: "ltrm (f [^]⇘P⇙ n) = (ltrm f) [^]⇘P⇙ n"
using A IH by blast
have 1: "ltrm (f [^]⇘P⇙ (Suc n)) = ltrm ((f [^]⇘P⇙ n)⊗⇘P⇙ f)"
by auto then
show ?thesis using ltrm_mult 0 1
by (simp add: A)
qed
qed
qed
lemma(in UP_domain) ltrm_pow:
assumes "f ∈ carrier P"
shows " ltrm (f [^]⇘P⇙ (n::nat)) = (ltrm f) [^]⇘P⇙ n"
using assms ltrm_pow0 by blast
text‹lemma on the leading coefficient›
lemma lcf_eq:
assumes "f ∈ carrier P"
shows "lcf f = lcf (ltrm f)"
using ltrm_deg_0
by (simp add: ltrm_cfs assms deg_ltrm)
lemma lcf_eq_deg_eq_imp_ltrm_eq:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "degree p > 0"
assumes "degree p = degree q"
assumes "lcf p = lcf q"
shows "ltrm p = ltrm q"
using assms(4) assms(5)
by (simp add: leading_term_def)
lemma ltrm_eq_imp_lcf_eq:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "ltrm p = ltrm q"
shows "lcf p = lcf q"
using assms
by (metis lcf_eq)
lemma ltrm_eq_imp_deg_drop:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "ltrm p = ltrm q"
assumes "degree p >0"
shows "degree (p ⊖⇘P⇙ q) < degree p"
proof-
have P0: "degree p = degree q"
by (metis assms(1) assms(2) assms(3) deg_ltrm)
then have P1: "degree (p ⊖⇘P⇙ q) ≤ degree p"
by (metis P.add.inv_solve_right P.minus_closed P.minus_eq assms(1)
assms(2) degree_of_sum_diff_degree neqE order.strict_implies_order order_refl)
have "degree (p ⊖⇘P⇙ q) ≠ degree p"
proof
assume A: "degree (p ⊖⇘P⇙ q) = degree p"
have Q0: "p ⊖⇘P⇙ q = ((trunc p) ⊕⇘P⇙ (ltrm p)) ⊖⇘P⇙ ((trunc q) ⊕⇘P⇙ (ltrm p))"
using assms(1) assms(2) assms(3) trunc_simps(1) by force
have Q1: "p ⊖⇘P⇙ q = (trunc p) ⊖⇘P⇙ (trunc q)"
proof-
have "p ⊖⇘P⇙ q = ((trunc p) ⊕⇘P⇙ (ltrm p)) ⊖⇘P⇙ (trunc q) ⊖ ⇘P⇙ (ltrm p)"
using Q0
by (simp add: P.minus_add P.minus_eq UP_a_assoc assms(1) assms(2) ltrm_closed trunc_closed)
then show ?thesis
by (metis (no_types, lifting) ltrm_closed P.add.inv_mult_group P.minus_eq
P.r_neg2 UP_a_assoc assms(1) assms(2) assms(3) carrier_is_submodule submoduleE(6) trunc_closed trunc_simps(1))
qed
have Q2: "degree (trunc p) < degree p"
by (simp add: assms(1) assms(4) trunc_degree)
have Q3: "degree (trunc q) < degree q"
using P0 assms(2) assms(4) trunc_degree by auto
then show False using A Q1 Q2 Q3 by (simp add: P.add.inv_solve_right
P.minus_eq P0 assms(1) assms(2) degree_of_sum_diff_degree trunc_closed)
qed
then show ?thesis
using P1 by auto
qed
lemma(in UP_cring) cring_lcf_scalar_mult:
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
assumes "a ⊗ (lcf p) ≠𝟬"
shows "lcf (a ⊙⇘P⇙ p) = a ⊗ (lcf p)"
proof-
have 0: "lcf (a ⊙⇘P⇙ p) = lcf (ltrm (a ⊙⇘P⇙ p))"
using assms lcf_eq smult_closed by blast
have 1: "degree (a ⊙⇘P⇙ p) = degree p"
by (smt lcf_monom(1) P_def R.one_closed R.r_null UP_ring.coeff_smult UP_ring_axioms
assms(1) assms(2) assms(3) coeff_simp cring_deg_mult deg_const monom_closed monom_mult_is_smult smult_one)
then have "lcf (a ⊙⇘P⇙ p) = lcf (a ⊙⇘P⇙ (ltrm p))"
using lcf_eq[of "a ⊙⇘P⇙ p"] smult_closed assms 0
by (metis cfs_closed cfs_smult monom_mult_smult)
then show ?thesis
unfolding leading_term_def
by (metis P_def R.m_closed UP_cring.lcf_monom UP_cring_axioms assms(1) assms(2) cfs_closed monom_mult_smult)
qed
lemma(in UP_domain) lcf_scalar_mult:
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
shows "lcf (a ⊙⇘P⇙ p) = a ⊗ (lcf p)"
proof-
have "lcf (a ⊙⇘P⇙ p) = lcf (ltrm (a ⊙⇘P⇙ p))"
using lcf_eq UP_smult_closed assms(1) assms(2) by blast
then have "lcf (a ⊙⇘P⇙ p) = lcf (a ⊙⇘P⇙ (ltrm p))"
using ltrm_smult assms(1) assms(2) by metis
then show ?thesis
by (metis (full_types) UP_smult_zero assms(1) assms(2) cfs_smult cfs_zero deg_smult)
qed
lemma(in UP_cring) cring_lcf_mult:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "(lcf p) ⊗ (lcf q) ≠𝟬"
shows "lcf (p ⊗⇘P⇙ q) = (lcf p) ⊗ (lcf q)"
using assms cring_ltrm_mult
by (smt lcf_monom(1) P.m_closed R.m_closed cfs_closed monom_mult)
lemma(in UP_domain) lcf_mult:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
shows "lcf (p ⊗⇘P⇙ q) = (lcf p) ⊗ (lcf q)"
by (smt ltrm_deg_0 R.integral_iff assms(1) assms(2) cfs_closed cring_lcf_mult deg_zero deg_ltrm local.integral_iff monom_zero)
lemma(in UP_cring) cring_lcf_pow:
assumes "p ∈ carrier P"
assumes "(lcf p)[^]n ≠𝟬"
shows "lcf (p[^]⇘P⇙(n::nat)) = (lcf p)[^]n"
by (smt P.nat_pow_closed R.nat_pow_closed assms(1) assms(2) cring_pow_ltrm lcf_closed lcf_ltrm lcf_monom monom_pow)
lemma(in UP_domain) lcf_pow:
assumes "p ∈ carrier P"
shows "lcf (p[^]⇘P⇙(n::nat)) = (lcf p)[^]n"
proof-
show ?thesis
proof(induction n)
case 0
then show ?case
by (metis Group.nat_pow_0 P_def R.one_closed UP_cring.lcf_monom UP_cring_axioms monom_one)
next
case (Suc n)
fix n
assume IH: "lcf (p[^]⇘P⇙(n::nat)) = (lcf p)[^]n"
show "lcf (p[^]⇘P⇙(Suc n)) = (lcf p)[^](Suc n)"
proof-
have "lcf (p[^]⇘P⇙(Suc n)) = lcf ((p[^]⇘P⇙n) ⊗⇘P⇙p)"
by simp
then have "lcf (p[^]⇘P⇙(Suc n)) = (lcf p)[^]n ⊗ (lcf p)"
by (simp add: IH assms lcf_mult)
then show ?thesis by auto
qed
qed
qed
end
subsection‹Constant Terms and Constant Coefficients›
text‹Constant term and coefficient function›
definition zcf where
"zcf f = (f 0)"
abbreviation(in UP_cring)(input) ctrm where
"ctrm f ≡ monom P (f 0) 0"
context UP_cring
begin
lemma ctrm_is_poly:
assumes "p ∈ carrier P"
shows "ctrm p ∈ carrier P"
by (simp add: assms cfs_closed)
lemma ctrm_degree:
assumes "p ∈ carrier P"
shows "degree (ctrm p) = 0"
by (simp add: assms cfs_closed)
lemma ctrm_zcf:
assumes "f ∈ carrier P"
assumes "zcf f = 𝟬"
shows "ctrm f = 𝟬⇘P⇙"
by (metis P_def UP_ring.monom_zero UP_ring_axioms zcf_def assms(2))
lemma zcf_degree_zero:
assumes "f ∈ carrier P"
assumes "degree f = 0"
shows "lcf f = zcf f"
by (simp add: zcf_def assms(2))
lemma zcf_zero_degree_zero:
assumes "f ∈ carrier P"
assumes "degree f = 0"
assumes "zcf f = 𝟬"
shows "f = 𝟬⇘P⇙"
using zcf_degree_zero[of f] assms ltrm_deg_0[of f]
by simp
lemma zcf_ctrm:
assumes "p ∈ carrier P"
shows "zcf (ctrm p) = zcf p"
unfolding zcf_def
using P_def UP_ring.cfs_monom UP_ring_axioms assms cfs_closed by fastforce
lemma ctrm_trunc:
assumes "p ∈ carrier P"
assumes "degree p >0"
shows "zcf(trunc p) = zcf p"
by (simp add: zcf_def assms(1) assms(2) trunc_cfs)
text‹Constant coefficient function is a ring homomorphism›
lemma zcf_add:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
shows "zcf(p ⊕⇘P⇙ q) = (zcf p) ⊕ (zcf q)"
by (simp add: zcf_def assms(1) assms(2))
lemma coeff_ltrm[simp]:
assumes "p ∈ carrier P"
assumes "degree p > 0"
shows "zcf(ltrm p) = 𝟬"
by (metis ltrm_cfs_above_deg ltrm_cfs zcf_def assms(1) assms(2))
lemma zcf_zero[simp]:
"zcf 𝟬⇘P⇙ = 𝟬"
using zcf_degree_zero by auto
lemma zcf_one[simp]:
"zcf 𝟭⇘P⇙ = 𝟭"
by (simp add: zcf_def)
lemma ctrm_smult:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "ctrm (a ⊙⇘P⇙ f) = a ⊙⇘P⇙(ctrm f)"
using P_def UP_ring.monom_mult_smult UP_ring_axioms assms(1) assms(2) cfs_smult coeff_simp
by (simp add: UP_ring.monom_mult_smult cfs_closed)
lemma ctrm_monom[simp]:
assumes "a ∈ carrier R"
shows "ctrm (monom P a (Suc k)) = 𝟬⇘P⇙"
by (simp add: assms cfs_monom)
end
subsection‹Polynomial Induction Rules›
context UP_ring
begin
text‹Rule for strong induction on polynomial degree›
lemma poly_induct:
assumes "p ∈ carrier P"
assumes Deg_0: "⋀p. p ∈ carrier P ⟹ degree p = 0 ⟹ Q p"
assumes IH: "⋀p. (⋀q. q ∈ carrier P ⟹ degree q < degree p ⟹ Q q) ⟹ p ∈ carrier P ⟹ degree p > 0 ⟹ Q p"
shows "Q p"
proof-
have "⋀n. ⋀p. p ∈ carrier P ⟹ degree p ≤ n ⟹ Q p"
proof-
fix n
show "⋀p. p ∈ carrier P ⟹ degree p ≤ n ⟹ Q p"
proof(induction n)
case 0
then show ?case
using Deg_0 by simp
next
case (Suc n)
fix n
assume I: "⋀p. p ∈ carrier P ⟹ degree p ≤ n ⟹ Q p"
show "⋀p. p ∈ carrier P ⟹ degree p ≤ (Suc n) ⟹ Q p"
proof-
fix p
assume A0: " p ∈ carrier P "
assume A1: "degree p ≤Suc n"
show "Q p"
proof(cases "degree p < Suc n")
case True
then show ?thesis
using I A0 by auto
next
case False
then have D: "degree p = Suc n"
by (simp add: A1 nat_less_le)
then have "(⋀q. q ∈ carrier P ⟹ degree q < degree p ⟹ Q q)"
using I by simp
then show "Q p"
using IH D A0 A1 Deg_0 by blast
qed
qed
qed
qed
then show ?thesis using assms by blast
qed
text‹Variant on induction on degree›
lemma poly_induct2:
assumes "p ∈ carrier P"
assumes Deg_0: "⋀p. p ∈ carrier P ⟹ degree p = 0 ⟹ Q p"
assumes IH: "⋀p. degree p > 0 ⟹ p ∈ carrier P ⟹ Q (trunc p) ⟹ Q p"
shows "Q p"
proof(rule poly_induct)
show "p ∈ carrier P"
by (simp add: assms(1))
show "⋀p. p ∈ carrier P ⟹ degree p = 0 ⟹ Q p"
by (simp add: Deg_0)
show "⋀p. (⋀q. q ∈ carrier P ⟹ degree q < degree p ⟹ Q q) ⟹ p ∈ carrier P ⟹ 0 < degree p ⟹ Q p"
proof-
fix p
assume A0: "(⋀q. q ∈ carrier P ⟹ degree q < degree p ⟹ Q q)"
assume A1: " p ∈ carrier P"
assume A2: "0 < degree p"
show "Q p"
proof-
have "degree (trunc p) < degree p"
by (simp add: A1 A2 trunc_degree)
have "Q (trunc p)"
by (simp add: A0 A1 ‹degree (trunc p) < degree p› trunc_closed)
then show ?thesis
by (simp add: A1 A2 IH)
qed
qed
qed
text‹Additive properties which are true for all monomials are true for all polynomials ›
lemma poly_induct3:
assumes "p ∈ carrier P"
assumes add: "⋀p q. q ∈ carrier P ⟹ p ∈ carrier P ⟹ Q p ⟹ Q q ⟹ Q (p ⊕⇘P⇙ q)"
assumes monom: "⋀a n. a ∈ carrier R ⟹ Q (monom P a n)"
shows "Q p"
apply(rule poly_induct2)
apply (simp add: assms(1))
apply (metis lcf_closed P_def coeff_simp deg_zero_impl_monom monom)
by (metis lcf_closed ltrm_closed add monom trunc_closed trunc_simps(1))
lemma poly_induct4:
assumes "p ∈ carrier P"
assumes add: "⋀p q. q ∈ carrier P ⟹ p ∈ carrier P ⟹ Q p ⟹ Q q ⟹ Q (p ⊕⇘P⇙ q)"
assumes monom_zero: "⋀a. a ∈ carrier R ⟹ Q (monom P a 0)"
assumes monom_Suc: "⋀a n. a ∈ carrier R ⟹ Q (monom P a (Suc n))"
shows "Q p"
apply(rule poly_induct3)
using assms(1) apply auto[1]
using add apply blast
using monom_zero monom_Suc
by (metis P_def UP_ring.monom_zero UP_ring_axioms deg_monom deg_monom_le le_0_eq le_SucE zero_induct)
lemma monic_monom_smult:
assumes "a ∈ carrier R"
shows "a ⊙⇘P⇙ monom P 𝟭 n = monom P a n"
using assms
by (metis R.one_closed R.r_one monom_mult_smult)
lemma poly_induct5:
assumes "p ∈ carrier P"
assumes add: "⋀p q. q ∈ carrier P ⟹ p ∈ carrier P ⟹ Q p ⟹ Q q ⟹ Q (p ⊕⇘P⇙ q)"
assumes monic_monom: "⋀n. Q (monom P 𝟭 n)"
assumes smult: "⋀p a . a ∈ carrier R ⟹ p ∈ carrier P ⟹ Q p ⟹ Q (a ⊙⇘P⇙ p)"
shows "Q p"
apply(rule poly_induct3)
apply (simp add: assms(1))
using add apply blast
proof-
fix a n assume A: "a ∈ carrier R" show "Q (monom P a n)"
using monic_monom[of n] smult[of a "monom P 𝟭 n"] monom_mult_smult[of a 𝟭 n]
by (simp add: A)
qed
lemma poly_induct6:
assumes "p ∈ carrier P"
assumes monom: "⋀a n. a ∈ carrier R ⟹ Q (monom P a 0)"
assumes plus_monom: "⋀a n p. a ∈ carrier R ⟹ a ≠ 𝟬 ⟹ p ∈ carrier P ⟹ degree p < n ⟹ Q p ⟹
Q(p ⊕⇘P⇙ monom P a n)"
shows "Q p"
apply(rule poly_induct2)
using assms(1) apply auto[1]
apply (metis lcf_closed P_def coeff_simp deg_zero_impl_monom monom)
using plus_monom
by (metis lcf_closed P_def coeff_simp lcoeff_nonzero_deg nat_less_le trunc_closed trunc_degree trunc_simps(1))
end
section‹Mapping a Polynomial to its Associated Ring Function›
text‹Turning a polynomial into a function on R:›
definition to_function where
"to_function S f = (λs ∈ carrier S. eval S S (λx. x) s f)"
context UP_cring
begin
definition to_fun where
"to_fun f ≡ to_function R f"
text‹Explicit formula for evaluating a polynomial function:›
lemma to_fun_eval:
assumes "f ∈ carrier P"
assumes "x ∈ carrier R"
shows "to_fun f x = eval R R (λx. x) x f"
using assms unfolding to_function_def to_fun_def
by auto
lemma to_fun_formula:
assumes "f ∈ carrier P"
assumes "x ∈ carrier R"
shows "to_fun f x = (⨁i ∈ {..degree f}. (f i) ⊗ x [^] i)"
proof-
have "f ∈ carrier (UP R)"
using assms P_def by auto
then have "eval R R (λx. x) x f = (⨁⇘R⇙i∈{..deg R f}. (λx. x) (coeff (UP R) f i) ⊗⇘R⇙ x [^]⇘R⇙ i)"
apply(simp add:UnivPoly.eval_def) done
then have "to_fun f x = (⨁⇘R⇙i∈{..deg R f}. (λx. x) (coeff (UP R) f i) ⊗⇘R⇙ x [^]⇘R⇙ i)"
using to_function_def assms unfolding to_fun_def
by (simp add: to_function_def)
then show ?thesis
by(simp add: assms coeff_simp)
qed
lemma eval_ring_hom:
assumes "a ∈ carrier R"
shows "eval R R (λx. x) a ∈ ring_hom P R"
proof-
have "(λx. x) ∈ ring_hom R R"
apply(rule ring_hom_memI)
apply auto done
then have "UP_pre_univ_prop R R (λx. x)"
using R_cring UP_pre_univ_propI by blast
then show ?thesis
by (simp add: P_def UP_pre_univ_prop.eval_ring_hom assms)
qed
lemma to_fun_closed:
assumes "f ∈ carrier P"
assumes "x ∈ carrier R"
shows "to_fun f x ∈ carrier R"
using assms to_fun_eval[of f x] eval_ring_hom[of x]
ring_hom_closed
by fastforce
lemma to_fun_plus:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "x ∈ carrier R"
shows "to_fun (f ⊕⇘P⇙ g) x = (to_fun f x) ⊕ (to_fun g x)"
using assms to_fun_eval[of ] eval_ring_hom[of x]
by (simp add: ring_hom_add)
lemma to_fun_mult:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "x ∈ carrier R"
shows "to_fun (f ⊗⇘P⇙ g) x = (to_fun f x) ⊗ (to_fun g x)"
using assms to_fun_eval[of ] eval_ring_hom[of x]
by (simp add: ring_hom_mult)
lemma to_fun_ring_hom:
assumes "a ∈ carrier R"
shows "(λp. to_fun p a) ∈ ring_hom P R"
apply(rule ring_hom_memI)
apply (simp add: assms to_fun_closed)
apply (simp add: assms to_fun_mult)
apply (simp add: assms to_fun_plus)
using to_fun_eval[of "𝟭⇘P⇙" a] eval_ring_hom[of a]
ring_hom_closed
by (simp add: assms ring_hom_one)
lemma ring_hom_uminus:
assumes "ring S"
assumes "f ∈ (ring_hom S R)"
assumes "a ∈ carrier S"
shows "f (⊖⇘S⇙ a) = ⊖ (f a)"
proof-
have "f (a ⊖⇘S⇙ a) = (f a) ⊕ f (⊖⇘S⇙ a)"
unfolding a_minus_def
by (simp add: assms(1) assms(2) assms(3) ring.ring_simprules(3) ring_hom_add)
then have "(f a) ⊕ f (⊖⇘S⇙ a) = 𝟬 "
by (metis R.ring_axioms a_minus_def assms(1) assms(2) assms(3)
ring.ring_simprules(16) ring_hom_zero)
then show ?thesis
by (metis (no_types, lifting) R.add.m_comm R.minus_equality assms(1)
assms(2) assms(3) ring.ring_simprules(3) ring_hom_closed)
qed
lemma to_fun_minus:
assumes "f ∈ carrier P"
assumes "x ∈ carrier R"
shows "to_fun (⊖⇘P⇙f) x = ⊖ (to_fun f x)"
unfolding to_function_def to_fun_def
using eval_ring_hom[of x] assms
by (simp add: UP_ring ring_hom_uminus)
lemma id_is_hom:
"ring_hom_cring R R (λx. x)"
proof(rule ring_hom_cringI)
show "cring R"
by (simp add: R_cring )
show "cring R"
by (simp add: R_cring )
show "(λx. x) ∈ ring_hom R R"
unfolding ring_hom_def
apply(auto)
done
qed
lemma UP_pre_univ_prop_fact:
"UP_pre_univ_prop R R (λx. x)"
unfolding UP_pre_univ_prop_def
by (simp add: UP_cring_def R_cring id_is_hom)
end
subsection‹to-fun is a Ring Homomorphism from Polynomials to Functions›
context UP_cring
begin
lemma to_fun_is_Fun:
assumes "x ∈ carrier P"
shows "to_fun x ∈ carrier (Fun R)"
apply(rule ring_functions.function_ring_car_memI)
unfolding ring_functions_def apply(simp add: R.ring_axioms)
using to_fun_closed assms apply auto[1]
unfolding to_function_def to_fun_def by auto
lemma to_fun_Fun_mult:
assumes "x ∈ carrier P"
assumes "y ∈ carrier P"
shows "to_fun (x ⊗⇘P⇙ y) = to_fun x ⊗⇘function_ring (carrier R) R⇙ to_fun y"
apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
apply (simp add: R.ring_axioms ring_functions_def)
apply (simp add: assms(1) assms(2) to_fun_is_Fun)
apply (simp add: R.ring_axioms assms(1) assms(2) ring_functions.fun_mult_closed ring_functions.intro to_fun_is_Fun)
by (simp add: R.ring_axioms assms(1) assms(2) ring_functions.function_mult_eval_car ring_functions.intro to_fun_is_Fun to_fun_mult)
lemma to_fun_Fun_add:
assumes "x ∈ carrier P"
assumes "y ∈ carrier P"
shows "to_fun (x ⊕⇘P⇙ y) = to_fun x ⊕⇘function_ring (carrier R) R⇙ to_fun y"
apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
apply (simp add: R.ring_axioms ring_functions_def)
apply (simp add: assms(1) assms(2) to_fun_is_Fun)
apply (simp add: R.ring_axioms assms(1) assms(2) ring_functions.fun_add_closed ring_functions.intro to_fun_is_Fun)
by (simp add: R.ring_axioms assms(1) assms(2) ring_functions.fun_add_eval_car ring_functions.intro to_fun_is_Fun to_fun_plus)
lemma to_fun_Fun_one:
"to_fun 𝟭⇘P⇙ = 𝟭⇘Fun R⇙"
apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
apply (simp add: R.ring_axioms ring_functions_def)
apply (simp add: to_fun_is_Fun)
apply (simp add: R.ring_axioms ring_functions.function_one_closed ring_functions_def)
using P_def R.ring_axioms UP_cring.eval_ring_hom UP_cring.to_fun_eval UP_cring_axioms UP_one_closed ring_functions.function_one_eval ring_functions.intro ring_hom_one
by fastforce
lemma to_fun_Fun_zero:
"to_fun 𝟬⇘P⇙ = 𝟬⇘Fun R⇙"
apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
apply (simp add: R.ring_axioms ring_functions_def)
apply (simp add: to_fun_is_Fun)
apply (simp add: R.ring_axioms ring_functions.function_zero_closed ring_functions_def)
using P_def R.ring_axioms UP_cring.eval_ring_hom UP_cring.to_fun_eval UP_cring_axioms UP_zero_closed ring_functions.function_zero_eval ring_functions.intro ring_hom_zero
by (metis UP_ring eval_ring_hom)
lemma to_fun_function_ring_hom:
"to_fun ∈ ring_hom P (Fun R)"
apply(rule ring_hom_memI)
using to_fun_is_Fun apply auto[1]
apply (simp add: to_fun_Fun_mult)
apply (simp add: to_fun_Fun_add)
by (simp add: to_fun_Fun_one)
lemma(in UP_cring) to_fun_one:
assumes "a ∈ carrier R"
shows "to_fun 𝟭⇘P⇙ a = 𝟭"
using assms to_fun_Fun_one
by (metis P_def UP_cring.to_fun_eval UP_cring_axioms UP_one_closed eval_ring_hom ring_hom_one)
lemma(in UP_cring) to_fun_zero:
assumes "a ∈ carrier R"
shows "to_fun 𝟬⇘P⇙ a = 𝟬"
by (simp add: assms R.ring_axioms ring_functions.function_zero_eval ring_functions.intro to_fun_Fun_zero)
lemma(in UP_cring) to_fun_nat_pow:
assumes "h ∈ carrier (UP R)"
assumes "a ∈ carrier R"
shows "to_fun (h[^]⇘UP R⇙(n::nat)) a = (to_fun h a)[^]n"
apply(induction n)
using assms to_fun_one
apply (metis P.nat_pow_0 P_def R.nat_pow_0)
using assms to_fun_mult P.nat_pow_closed P_def by auto
lemma(in UP_cring) to_fun_finsum:
assumes "finite (Y::'d set)"
assumes "f ∈ UNIV → carrier (UP R)"
assumes "t ∈ carrier R"
shows "to_fun (finsum (UP R) f Y) t = finsum R (λi. (to_fun (f i) t)) Y"
proof(rule finite.induct[of Y])
show "finite Y"
using assms by blast
show "to_fun (finsum (UP R) f {}) t = (⨁i∈{}. to_fun (f i) t)"
using P.finsum_empty[of f] assms unfolding P_def R.finsum_empty
using P_def to_fun_zero by presburger
show "⋀A a. finite A ⟹
to_fun (finsum (UP R) f A) t = (⨁i∈A. to_fun (f i) t) ⟹ to_fun (finsum (UP R) f (insert a A)) t = (⨁i∈insert a A. to_fun (f i) t)"
proof-
fix A :: "'d set" fix a
assume A: "finite A" "to_fun (finsum (UP R) f A) t = (⨁i∈A. to_fun (f i) t)"
show "to_fun (finsum (UP R) f (insert a A)) t = (⨁i∈insert a A. to_fun (f i) t)"
proof(cases "a ∈ A")
case True
then show ?thesis using A
by (metis insert_absorb)
next
case False
have 0: "finsum (UP R) f (insert a A) = f a ⊕⇘UP R⇙ finsum (UP R) f A"
using A False finsum_insert[of A a f] assms unfolding P_def by blast
have 1: "to_fun (f a ⊕⇘P⇙finsum (UP R) f A ) t = to_fun (f a) t ⊕ to_fun (finsum (UP R) f A) t"
apply(rule to_fun_plus[of "finsum (UP R) f A" "f a" t])
using assms(2) finsum_closed[of f A] A unfolding P_def apply blast
using P_def assms apply blast
using assms by blast
have 2: "to_fun (f a ⊕⇘P⇙finsum (UP R) f A ) t = to_fun (f a) t ⊕ (⨁i∈A. to_fun (f i) t)"
unfolding 1 A by blast
have 3: "(⨁i∈insert a A. to_fun (f i) t) = to_fun (f a) t ⊕ (⨁i∈A. to_fun (f i) t)"
apply(rule R.finsum_insert, rule A, rule False)
using to_fun_closed assms unfolding P_def apply blast
apply(rule to_fun_closed) using assms unfolding P_def apply blast using assms by blast
show ?thesis
unfolding 0 unfolding 3 using 2 unfolding P_def by blast
qed
qed
qed
end
subsection‹Inclusion of a Ring into its Polynomials Ring via Constants›
definition to_polynomial where
"to_polynomial R = (λa. monom (UP R) a 0)"
context UP_cring
begin
abbreviation(input) to_poly where
"to_poly ≡ to_polynomial R"
lemma to_poly_mult_simp:
assumes "b ∈ carrier R"
assumes "f ∈ carrier (UP R)"
shows "(to_polynomial R b) ⊗⇘UP R⇙ f = b ⊙⇘UP R⇙ f"
"f ⊗⇘UP R⇙ (to_polynomial R b) = b ⊙⇘UP R⇙ f"
unfolding to_polynomial_def
using assms P_def monom_mult_is_smult apply auto[1]
using UP_cring.UP_m_comm UP_cring_axioms UP_ring.monom_closed
UP_ring.monom_mult_is_smult UP_ring_axioms assms(1) assms(2)
by fastforce
lemma to_fun_to_poly:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "to_fun (to_poly a) b = a"
unfolding to_function_def to_fun_def to_polynomial_def
by (simp add: UP_pre_univ_prop.eval_const UP_pre_univ_prop_fact assms(1) assms(2))
lemma to_poly_inverse:
assumes "f ∈ carrier P"
assumes "degree f = 0"
shows "f = to_poly (f 0)"
using P_def assms(1) assms(2)
by (metis ltrm_deg_0 to_polynomial_def)
lemma to_poly_closed:
assumes "a ∈ carrier R"
shows "to_poly a ∈ carrier P"
by (metis P_def assms monom_closed to_polynomial_def)
lemma degree_to_poly[simp]:
assumes "a ∈ carrier R"
shows "degree (to_poly a) = 0"
by (metis P_def assms deg_const to_polynomial_def)
lemma to_poly_is_ring_hom:
"to_poly ∈ ring_hom R P"
unfolding to_polynomial_def
unfolding P_def
using UP_ring.const_ring_hom[of R]
UP_ring_axioms by simp
lemma to_poly_add:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "to_poly (a ⊕ b) = to_poly a ⊕⇘P⇙ to_poly b"
by (simp add: assms(1) assms(2) ring_hom_add to_poly_is_ring_hom)
lemma to_poly_mult:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "to_poly (a ⊗ b) = to_poly a ⊗⇘P⇙ to_poly b"
by (simp add: assms(1) assms(2) ring_hom_mult to_poly_is_ring_hom)
lemma to_poly_minus:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "to_poly (a ⊖ b) = to_poly a ⊖⇘P⇙ to_poly b"
by (metis P.minus_eq P_def R.add.inv_closed R.ring_axioms UP_ring.monom_add
UP_ring_axioms assms(1) assms(2) monom_a_inv ring.ring_simprules(14) to_polynomial_def)
lemma to_poly_a_inv:
assumes "a ∈ carrier R"
shows "to_poly (⊖ a) = ⊖⇘P⇙ to_poly a"
by (metis P_def assms monom_a_inv to_polynomial_def)
lemma to_poly_nat_pow:
assumes "a ∈ carrier R"
shows "(to_poly a) [^]⇘P⇙ (n::nat)= to_poly (a[^]n)"
using assms UP_cring UP_cring_axioms UP_cring_def UnivPoly.ring_hom_cringI ring_hom_cring.hom_pow to_poly_is_ring_hom
by fastforce
end
section‹Polynomial Substitution›
definition compose where
"compose R f g = eval R (UP R) (to_polynomial R) g f"
abbreviation(in UP_cring)(input) sub (infixl "of" 70) where
"sub f g ≡ compose R f g"
definition rev_compose where
"rev_compose R = eval R (UP R) (to_polynomial R)"
abbreviation(in UP_cring)(input) rev_sub where
"rev_sub ≡ rev_compose R"
context UP_cring
begin
lemma sub_rev_sub:
"sub f g = rev_sub g f"
unfolding compose_def rev_compose_def
by simp
lemma(in UP_cring) to_poly_UP_pre_univ_prop:
"UP_pre_univ_prop R P to_poly"
proof
show "to_poly ∈ ring_hom R P"
by (simp add: to_poly_is_ring_hom)
qed
lemma rev_sub_is_hom:
assumes "g ∈ carrier P"
shows "rev_sub g ∈ ring_hom P P"
unfolding rev_compose_def
using to_poly_UP_pre_univ_prop assms(1) UP_pre_univ_prop.eval_ring_hom[of R P to_poly g]
unfolding P_def apply auto
done
lemma rev_sub_closed:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
shows "rev_sub q p ∈ carrier P"
using rev_sub_is_hom[of q] assms ring_hom_closed[of "rev_sub q" P P p] by auto
lemma sub_closed:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
shows "sub q p ∈ carrier P"
by (simp add: assms(1) assms(2) rev_sub_closed sub_rev_sub)
lemma rev_sub_add:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "h ∈carrier P"
shows "rev_sub g (f ⊕⇘P⇙ h) = (rev_sub g f) ⊕⇘P⇙ (rev_sub g h)"
using rev_sub_is_hom assms ring_hom_add by fastforce
lemma sub_add:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "h ∈carrier P"
shows "((f ⊕⇘P⇙ h) of g) = ((f of g) ⊕⇘P⇙ (h of g))"
by (simp add: assms(1) assms(2) assms(3) rev_sub_add sub_rev_sub)
lemma rev_sub_mult:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "h ∈carrier P"
shows "rev_sub g (f ⊗⇘P⇙ h) = (rev_sub g f) ⊗⇘P⇙ (rev_sub g h)"
using rev_sub_is_hom assms ring_hom_mult by fastforce
lemma sub_mult:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "h ∈carrier P"
shows "((f ⊗⇘P⇙ h) of g) = ((f of g) ⊗⇘P⇙ (h of g))"
by (simp add: assms(1) assms(2) assms(3) rev_sub_mult sub_rev_sub)
lemma sub_monom:
assumes "g ∈ carrier (UP R)"
assumes "a ∈ carrier R"
shows "sub (monom (UP R) a n) g = to_poly a ⊗⇘UP R⇙ (g[^]⇘UP R⇙ (n::nat))"
"sub (monom (UP R) a n) g = a ⊙⇘UP R⇙ (g[^]⇘UP R⇙ (n::nat))"
apply (simp add: UP_cring.to_poly_UP_pre_univ_prop UP_cring_axioms
UP_pre_univ_prop.eval_monom assms(1) assms(2) Cring_Poly.compose_def)
by (metis P_def UP_cring.to_poly_mult_simp(1) UP_cring_axioms UP_pre_univ_prop.eval_monom
UP_ring assms(1) assms(2) Cring_Poly.compose_def monoid.nat_pow_closed ring_def to_poly_UP_pre_univ_prop)
text‹Subbing into a constant does nothing›
lemma rev_sub_to_poly:
assumes "g ∈ carrier P"
assumes "a ∈ carrier R"
shows "rev_sub g (to_poly a) = to_poly a"
unfolding to_polynomial_def rev_compose_def
using to_poly_UP_pre_univ_prop
unfolding to_polynomial_def
using P_def UP_pre_univ_prop.eval_const assms(1) assms(2) by fastforce
lemma sub_to_poly:
assumes "g ∈ carrier P"
assumes "a ∈ carrier R"
shows "(to_poly a) of g = to_poly a"
by (simp add: assms(1) assms(2) rev_sub_to_poly sub_rev_sub)
lemma sub_const:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "degree f = 0"
shows "f of g = f"
by (metis lcf_closed assms(1) assms(2) assms(3) sub_to_poly to_poly_inverse)
text‹Substitution into a monomial›
lemma monom_sub:
assumes "a ∈ carrier R"
assumes "g ∈ carrier P"
shows "(monom P a n) of g = a ⊙⇘P⇙ g[^]⇘P⇙ n"
unfolding compose_def
using assms UP_pre_univ_prop.eval_monom[of R P to_poly a g n] to_poly_UP_pre_univ_prop
unfolding P_def
using P.nat_pow_closed P_def to_poly_mult_simp(1)
by (simp add: to_poly_mult_simp(1) UP_cring_axioms)
lemma(in UP_cring) cring_sub_monom_bound:
assumes "a ∈ carrier R"
assumes "a ≠𝟬"
assumes "f = monom P a n"
assumes "g ∈ carrier P"
shows "degree (f of g) ≤ n*(degree g)"
proof-
have "f of g = (to_poly a) ⊗⇘P⇙ (g[^]⇘P⇙n)"
unfolding compose_def
using assms UP_pre_univ_prop.eval_monom[of R P to_poly a g] to_poly_UP_pre_univ_prop
unfolding P_def
by blast
then show ?thesis
by (smt P.nat_pow_closed assms(1) assms(4) cring_pow_deg_bound deg_mult_ring
degree_to_poly le_trans plus_nat.add_0 to_poly_closed)
qed
lemma(in UP_cring) cring_sub_monom:
assumes "a ∈ carrier R"
assumes "a ≠𝟬"
assumes "f = monom P a n"
assumes "g ∈ carrier P"
assumes "a ⊗ (lcf g [^] n) ≠ 𝟬"
shows "degree (f of g) = n*(degree g)"
proof-
have 0: "f of g = (to_poly a) ⊗⇘P⇙ (g[^]⇘P⇙n)"
unfolding compose_def
using assms UP_pre_univ_prop.eval_monom[of R P to_poly a g] to_poly_UP_pre_univ_prop
unfolding P_def
by blast
have 1: "lcf (to_poly a) ⊗ lcf (g [^]⇘P⇙ n) ≠ 𝟬"
using assms
by (smt P.nat_pow_closed P_def R.nat_pow_closed R.r_null cring_pow_ltrm lcf_closed lcf_ltrm lcf_monom monom_pow to_polynomial_def)
then show ?thesis
using 0 1 assms cring_pow_deg[of g n] cring_deg_mult[of "to_poly a" "g[^]⇘P⇙n"]
by (metis P.nat_pow_closed R.r_null add.right_neutral degree_to_poly to_poly_closed)
qed
lemma(in UP_domain) sub_monom:
assumes "a ∈ carrier R"
assumes "a ≠𝟬"
assumes "f = monom P a n"
assumes "g ∈ carrier P"
shows "degree (f of g) = n*(degree g)"
proof-
have "f of g = (to_poly a) ⊗⇘P⇙ (g[^]⇘P⇙n)"
unfolding compose_def
using assms UP_pre_univ_prop.eval_monom[of R P to_poly a g] to_poly_UP_pre_univ_prop
unfolding P_def
by blast
then show ?thesis using deg_pow deg_mult
by (metis P.nat_pow_closed P_def assms(1) assms(2)
assms(4) deg_smult monom_mult_is_smult to_polynomial_def)
qed
text‹Subbing a constant into a polynomial yields a constant›
lemma sub_in_const:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "degree g = 0"
shows "degree (f of g) = 0"
proof-
have "⋀n. (⋀p. p ∈ carrier P ⟹ degree p ≤ n ⟹ degree (p of g) = 0)"
proof-
fix n
show "⋀p. p ∈ carrier P ⟹ degree p ≤ n ⟹ degree (p of g) = 0"
proof(induction n)
case 0
then show ?case
by (simp add: assms(1) sub_const)
next
case (Suc n)
fix n
assume IH: "⋀p. p ∈ carrier P ⟹ degree p ≤ n ⟹ degree (p of g) = 0"
show "⋀p. p ∈ carrier P ⟹ degree p ≤ (Suc n) ⟹ degree (p of g) = 0"
proof-
fix p
assume A0: "p ∈ carrier P"
assume A1: "degree p ≤ (Suc n)"
show "degree (p of g) = 0"
proof(cases "degree p < Suc n")
case True
then show ?thesis using IH
using A0 by auto
next
case False
then have D: "degree p = Suc n"
by (simp add: A1 nat_less_le)
show ?thesis
proof-
have P0: "degree ((trunc p) of g) = 0" using IH
by (metis A0 D less_Suc_eq_le trunc_degree trunc_closed zero_less_Suc)
have P1: "degree ((ltrm p) of g) = 0"
proof-
obtain a n where an_def: "ltrm p = monom P a n ∧ a ∈ carrier R"
unfolding leading_term_def
using A0 P_def cfs_closed by blast
obtain b where b_def: "g = monom P b 0 ∧ b ∈ carrier R"
using assms deg_zero_impl_monom coeff_closed
by blast
have 0: " monom P b 0 [^]⇘P⇙ n = monom P (b[^]n) 0"
apply(induction n)
apply fastforce[1]
proof- fix n::nat assume IH: "monom P b 0 [^]⇘P⇙ n = monom P (b [^] n) 0"
have "monom P b 0 [^]⇘P⇙ Suc n = (monom P (b[^]n) 0) ⊗⇘P⇙ monom P b 0"
using IH by simp
then have "monom P b 0 [^]⇘P⇙ Suc n = (monom P ((b[^]n)⊗b) 0)"
using b_def
by (simp add: monom_mult_is_smult monom_mult_smult)
then show "monom P b 0 [^]⇘P⇙ Suc n = monom P (b [^] Suc n) 0 "
by simp
qed
then have 0: "a ⊙⇘P⇙ monom P b 0 [^]⇘P⇙ n = monom P (a ⊗ b[^]n) 0"
by (simp add: an_def b_def monom_mult_smult)
then show ?thesis using monom_sub[of a "monom P b 0" n] assms an_def
by (simp add: ‹⟦a ∈ carrier R; monom P b 0 ∈ carrier P⟧ ⟹ monom P a n of monom P b 0 = a ⊙⇘P⇙ monom P b 0 [^]⇘P⇙ n› b_def)
qed
have P2: "p of g = (trunc p of g) ⊕⇘P⇙ ((ltrm p) of g)"
by (metis A0 assms(1) ltrm_closed sub_add trunc_simps(1) trunc_closed)
then show ?thesis
using P0 P1 P2 deg_add[of "trunc p of g" "ltrm p of g"]
by (metis A0 assms(1) le_0_eq ltrm_closed max_0R sub_closed trunc_closed)
qed
qed
qed
qed
qed
then show ?thesis
using assms(2) by blast
qed
lemma (in UP_cring) cring_sub_deg_bound:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
shows "degree (f of g) ≤ degree f * degree g"
proof-
have "⋀n. ⋀ p. p ∈ carrier P ⟹ (degree p) ≤ n ⟹ degree (p of g) ≤ degree p * degree g"
proof-
fix n::nat
show "⋀ p. p ∈ carrier P ⟹ (degree p) ≤ n ⟹ degree (p of g) ≤ degree p * degree g"
proof(induction n)
case 0
then have B0: "degree p = 0" by auto
then show ?case using sub_const[of g p]
by (simp add: "0.prems"(1) assms(1))
next
case (Suc n)
fix n
assume IH: "(⋀p. p ∈ carrier P ⟹ degree p ≤ n ⟹ degree (p of g) ≤ degree p * degree g)"
show " p ∈ carrier P ⟹ degree p ≤ Suc n ⟹ degree (p of g) ≤ degree p * degree g"
proof-
assume A0: "p ∈ carrier P"
assume A1: "degree p ≤ Suc n"
show ?thesis
proof(cases "degree p < Suc n")
case True
then show ?thesis using IH
by (simp add: A0)
next
case False
then have D: "degree p = Suc n"
using A1 by auto
have P0: "(p of g) = ((trunc p) of g) ⊕⇘P⇙ ((ltrm p) of g)"
by (metis A0 assms(1) ltrm_closed sub_add trunc_simps(1) trunc_closed)
have P1: "degree ((trunc p) of g) ≤ (degree (trunc p))*(degree g)"
using IH by (metis A0 D less_Suc_eq_le trunc_degree trunc_closed zero_less_Suc)
have P2: "degree ((ltrm p) of g) ≤ (degree p) * degree g"
using A0 D P_def UP_cring_axioms assms(1)
by (metis False cfs_closed coeff_simp cring_sub_monom_bound deg_zero lcoeff_nonzero2 less_Suc_eq_0_disj)
then show ?thesis
proof(cases "degree g = 0")
case True
then show ?thesis
by (simp add: Suc(2) assms(1) sub_in_const)
next
case F: False
then show ?thesis
proof-
have P3: "degree ((trunc p) of g) ≤ n*degree g"
using A0 False D P1 P2 IH[of "trunc p"] trunc_degree[of p]
proof -
{ assume "degree (trunc p) < degree p"
then have "degree (trunc p) ≤ n"
using D by auto
then have ?thesis
by (meson P1 le_trans mult_le_cancel2) }
then show ?thesis
by (metis (full_types) A0 D Suc_mult_le_cancel1 nat_mult_le_cancel_disj trunc_degree)
qed
then have P3': "degree ((trunc p) of g) < (degree p)*degree g"
using F D by auto
have P4: "degree (ltrm p of g) ≤ (degree p)*degree g"
using cring_sub_monom_bound D P2
by auto
then show ?thesis
using D P0 P1 P3 P4 A0 P3' assms(1) bound_deg_sum less_imp_le_nat
ltrm_closed sub_closed trunc_closed
by metis
qed
qed
qed
qed
qed
qed
then show ?thesis
using assms(2) by blast
qed
lemma (in UP_cring) cring_sub_deg:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "lcf f ⊗ (lcf g [^] (degree f)) ≠ 𝟬"
shows "degree (f of g) = degree f * degree g"
proof-
have 0: "f of g = (trunc f of g) ⊕⇘P⇙ ((ltrm f) of g)"
by (metis assms(1) assms(2) ltrm_closed rev_sub_add sub_rev_sub trunc_simps(1) trunc_closed)
have 1: "lcf f ≠ 𝟬"
using assms cring.cring_simprules(26) lcf_closed
by auto
have 2: "degree ((ltrm f) of g) = degree f * degree g"
using 0 1 assms cring_sub_monom[of "lcf f" "ltrm f" "degree f" g] lcf_closed lcf_ltrm
by blast
show ?thesis
apply(cases "degree f = 0")
apply (simp add: assms(1) assms(2))
apply(cases "degree g = 0")
apply (simp add: assms(1) assms(2) sub_in_const)
using 0 1 assms cring_sub_deg_bound[of g "trunc f"] trunc_degree[of f]
using sub_const apply auto[1]
apply(cases "degree g = 0")
using 0 1 assms cring_sub_deg_bound[of g "trunc f"] trunc_degree[of f]
using sub_in_const apply fastforce
unfolding 0 using 1 2
by (smt "0" ltrm_closed ‹⟦f ∈ carrier P; 0 < deg R f⟧ ⟹ deg R (Cring_Poly.truncate R f) < deg R f›
assms(1) assms(2) cring_sub_deg_bound degree_of_sum_diff_degree equal_deg_sum
le_eq_less_or_eq mult_less_cancel2 nat_neq_iff neq0_conv sub_closed trunc_closed)
qed
lemma (in UP_domain) sub_deg0:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "g ≠ 𝟬⇘P⇙"
assumes "f ≠ 𝟬⇘P⇙"
shows "degree (f of g) = degree f * degree g"
proof-
have "⋀n. ⋀ p. p ∈ carrier P ⟹ (degree p) ≤ n ⟹ degree (p of g) = degree p * degree g"
proof-
fix n::nat
show "⋀ p. p ∈ carrier P ⟹ (degree p) ≤ n ⟹ degree (p of g) = degree p * degree g"
proof(induction n)
case 0
then have B0: "degree p = 0" by auto
then show ?case using sub_const[of g p]
by (simp add: "0.prems"(1) assms(1))
next
case (Suc n)
fix n
assume IH: "(⋀p. p ∈ carrier P ⟹ degree p ≤ n ⟹ degree (p of g) = degree p * degree g)"
show " p ∈ carrier P ⟹ degree p ≤ Suc n ⟹ degree (p of g) = degree p * degree g"
proof-
assume A0: "p ∈ carrier P"
assume A1: "degree p ≤ Suc n"
show ?thesis
proof(cases "degree p < Suc n")
case True
then show ?thesis using IH
by (simp add: A0)
next
case False
then have D: "degree p = Suc n"
using A1 by auto
have P0: "(p of g) = ((trunc p) of g) ⊕⇘P⇙ ((ltrm p) of g)"
by (metis A0 assms(1) ltrm_closed sub_add trunc_simps(1) trunc_closed)
have P1: "degree ((trunc p) of g) = (degree (trunc p))*(degree g)"
using IH by (metis A0 D less_Suc_eq_le trunc_degree trunc_closed zero_less_Suc)
have P2: "degree ((ltrm p) of g) = (degree p) * degree g"
using A0 D P_def UP_domain.sub_monom UP_cring_axioms assms(1)
by (metis False UP_domain_axioms UP_ring.coeff_simp UP_ring.lcoeff_nonzero2 UP_ring_axioms cfs_closed deg_nzero_nzero less_Suc_eq_0_disj)
then show ?thesis
proof(cases "degree g = 0")
case True
then show ?thesis
by (simp add: Suc(2) assms(1) sub_in_const)
next
case False
then show ?thesis
proof-
have P3: "degree ((trunc p) of g) < degree ((ltrm p) of g)"
using False D P1 P2
by (metis (no_types, lifting) A0 mult.commute mult_right_cancel
nat_less_le nat_mult_le_cancel_disj trunc_degree zero_less_Suc)
then show ?thesis
by (simp add: A0 ltrm_closed P0 P2 assms(1) equal_deg_sum sub_closed trunc_closed)
qed
qed
qed
qed
qed
qed
then show ?thesis
using assms(2) by blast
qed
lemma(in UP_domain) sub_deg:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "g ≠ 𝟬⇘P⇙"
shows "degree (f of g) = degree f * degree g"
proof(cases "f = 𝟬⇘P⇙")
case True
then show ?thesis
using assms(1) sub_const by auto
next
case False
then show ?thesis
by (simp add: assms(1) assms(2) assms(3) sub_deg0)
qed
lemma(in UP_cring) cring_ltrm_sub:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "degree g > 0"
assumes "lcf f ⊗ (lcf g [^] (degree f)) ≠ 𝟬"
shows "ltrm (f of g) = ltrm ((ltrm f) of g)"
proof-
have P0: "degree (f of g) = degree ((ltrm f) of g)"
using assms(1) assms(2) assms(4) cring_sub_deg lcf_eq ltrm_closed deg_ltrm
by auto
have P1: "f of g = ((trunc f) of g) ⊕⇘P⇙((ltrm f) of g)"
by (metis assms(1) assms(2) ltrm_closed rev_sub_add sub_rev_sub trunc_simps(1) trunc_closed)
then show ?thesis
proof(cases "degree f = 0")
case True
then show ?thesis
using ltrm_deg_0 assms(2) by auto
next
case False
have P2: "degree (f of g) = degree f * degree g"
by (simp add: assms(1) assms(2) assms(4) cring_sub_deg)
then have P3: "degree ((trunc f) of g) < degree ((ltrm f) of g)"
using False P0 P1 P_def UP_cring.sub_closed trunc_closed UP_cring_axioms
UP_ring.degree_of_sum_diff_degree UP_ring.ltrm_closed UP_ring_axioms assms(1)
assms(2) assms(4) cring_sub_deg_bound le_antisym less_imp_le_nat less_nat_zero_code
mult_right_le_imp_le nat_neq_iff trunc_degree
by (smt assms(3))
then show ?thesis using P0 P1 P2
by (metis (no_types, lifting) ltrm_closed ltrm_of_sum_diff_degree P.add.m_comm assms(1) assms(2) sub_closed trunc_closed)
qed
qed
lemma(in UP_domain) ltrm_sub:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "degree g > 0"
shows "ltrm (f of g) = ltrm ((ltrm f) of g)"
proof-
have P0: "degree (f of g) = degree ((ltrm f) of g)"
using sub_deg
by (metis ltrm_closed assms(1) assms(2) assms(3) deg_zero deg_ltrm nat_neq_iff)
have P1: "f of g = ((trunc f) of g) ⊕⇘P⇙((ltrm f) of g)"
by (metis assms(1) assms(2) ltrm_closed rev_sub_add sub_rev_sub trunc_simps(1) trunc_closed)
then show ?thesis
proof(cases "degree f = 0")
case True
then show ?thesis
using ltrm_deg_0 assms(2) by auto
next
case False
then have P2: "degree ((trunc f) of g) < degree ((ltrm f) of g)"
using sub_deg
by (metis (no_types, lifting) ltrm_closed assms(1) assms(2) assms(3) deg_zero
deg_ltrm mult_less_cancel2 neq0_conv trunc_closed trunc_degree)
then show ?thesis
using P0 P1 P2
by (metis (no_types, lifting) ltrm_closed ltrm_of_sum_diff_degree P.add.m_comm assms(1) assms(2) sub_closed trunc_closed)
qed
qed
lemma(in UP_cring) cring_lcf_of_sub_in_ltrm:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "degree f = n"
assumes "degree g > 0"
assumes "(lcf f) ⊗ ((lcf g)[^]n) ≠𝟬"
shows "lcf ((ltrm f) of g) = (lcf f) ⊗ ((lcf g)[^]n)"
by (metis (no_types, lifting) P.nat_pow_closed P_def R.r_null UP_cring.monom_sub UP_cring_axioms
assms(1) assms(2) assms(3) assms(5) cfs_closed cring_lcf_pow cring_lcf_scalar_mult)
lemma(in UP_domain) lcf_of_sub_in_ltrm:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "degree f = n"
assumes "degree g > 0"
shows "lcf ((ltrm f) of g) = (lcf f) ⊗ ((lcf g)[^]n)"
proof(cases "degree f = 0")
case True
then show ?thesis
using ltrm_deg_0 assms(1) assms(2) assms(3) cfs_closed
by (simp add: sub_const)
next
case False
then show ?thesis
proof-
have P0: "(ltrm f) of g = (to_poly (lcf f)) ⊗⇘P⇙ (g[^]⇘P⇙n)"
unfolding compose_def
using assms UP_pre_univ_prop.eval_monom[of R P to_poly "(lcf f)" g n] to_poly_UP_pre_univ_prop
unfolding P_def
using P_def cfs_closed by blast
have P1: "(ltrm f) of g = (lcf f) ⊙⇘P⇙(g[^]⇘P⇙n)"
using P0 P.nat_pow_closed
by (simp add: assms(1) assms(2) assms(3) cfs_closed monom_sub)
have P2: "ltrm ((ltrm f) of g) = (ltrm (to_poly (lcf f))) ⊗⇘P⇙ (ltrm (g[^]⇘P⇙n))"
using P0 ltrm_mult P.nat_pow_closed P_def assms(1) assms(2)
to_poly_closed
by (simp add: cfs_closed)
have P3: "ltrm ((ltrm f) of g) = (to_poly (lcf f)) ⊗⇘P⇙ (ltrm (g[^]⇘P⇙n))"
using P2 ltrm_deg_0 assms(2) to_poly_closed
by (simp add: cfs_closed)
have P4: "ltrm ((ltrm f) of g) = (lcf f) ⊙⇘P⇙ ((ltrm g)[^]⇘P⇙n)"
using P.nat_pow_closed P1 P_def assms(1) assms(2) ltrm_pow0 ltrm_smult
by (simp add: cfs_closed)
have P5: "lcf ((ltrm f) of g) = (lcf f) ⊗ (lcf ((ltrm g)[^]⇘P⇙n))"
using lcf_scalar_mult P4 by (metis P.nat_pow_closed P1 cfs_closed
UP_smult_closed assms(1) assms(2) assms(3) lcf_eq ltrm_closed sub_rev_sub)
show ?thesis
using P5 ltrm_pow lcf_pow assms(1) lcf_eq ltrm_closed by presburger
qed
qed
lemma(in UP_cring) cring_ltrm_of_sub_in_ltrm:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "degree f = n"
assumes "degree g > 0"
assumes "(lcf f) ⊗ ((lcf g)[^]n) ≠𝟬"
shows "ltrm ((ltrm f) of g) = (lcf f) ⊙⇘P⇙ ((ltrm g)[^]⇘P⇙n)"
by (smt lcf_eq ltrm_closed R.nat_pow_closed R.r_null assms(1) assms(2) assms(3)
assms(4) assms(5) cfs_closed cring_lcf_of_sub_in_ltrm cring_lcf_pow cring_pow_ltrm
cring_pow_deg cring_sub_deg deg_zero deg_ltrm monom_mult_smult neq0_conv)
lemma(in UP_domain) ltrm_of_sub_in_ltrm:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "degree f = n"
assumes "degree g > 0"
shows "ltrm ((ltrm f) of g) = (lcf f) ⊙⇘P⇙ ((ltrm g)[^]⇘P⇙n)"
by (smt Group.nat_pow_0 lcf_of_sub_in_ltrm lcf_pow lcf_scalar_mult ltrm_closed
ltrm_pow0 ltrm_smult P.nat_pow_closed P_def UP_ring.monom_one UP_ring_axioms assms(1)
assms(2) assms(3) assms(4) cfs_closed coeff_simp deg_const deg_nzero_nzero deg_pow
deg_smult deg_ltrm lcoeff_nonzero2 nat_less_le sub_deg)
text‹formula for the leading term of a composition ›
lemma(in UP_domain) cring_ltrm_of_sub:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "degree f = n"
assumes "degree g > 0"
assumes "(lcf f) ⊗ ((lcf g)[^]n) ≠𝟬"
shows "ltrm (f of g) = (lcf f) ⊙⇘P⇙ ((ltrm g)[^]⇘P⇙n)"
using ltrm_of_sub_in_ltrm ltrm_sub assms(1) assms(2) assms(3) assms(4) by presburger
lemma(in UP_domain) ltrm_of_sub:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "degree f = n"
assumes "degree g > 0"
shows "ltrm (f of g) = (lcf f) ⊙⇘P⇙ ((ltrm g)[^]⇘P⇙n)"
using ltrm_of_sub_in_ltrm ltrm_sub assms(1) assms(2) assms(3) assms(4) by presburger
text‹subtitution is associative›
lemma sub_assoc_monom:
assumes "f ∈ carrier P"
assumes "q ∈ carrier P"
assumes "r ∈ carrier P"
shows "(ltrm f) of (q of r) = ((ltrm f) of q) of r"
proof-
obtain n where n_def: "n = degree f"
by simp
obtain a where a_def: "a ∈ carrier R ∧ (ltrm f) = monom P a n"
using assms(1) cfs_closed n_def by blast
have LHS: "(ltrm f) of (q of r) = a ⊙⇘P⇙ (q of r)[^]⇘P⇙ n"
by (metis P.nat_pow_closed P_def UP_pre_univ_prop.eval_monom a_def assms(2)
assms(3) compose_def monom_mult_is_smult sub_closed to_poly_UP_pre_univ_prop to_polynomial_def)
have RHS0: "((ltrm f) of q) of r = (a ⊙⇘P⇙ q[^]⇘P⇙ n)of r"
by (metis P.nat_pow_closed P_def UP_pre_univ_prop.eval_monom a_def
assms(2) compose_def monom_mult_is_smult to_poly_UP_pre_univ_prop to_polynomial_def)
have RHS1: "((ltrm f) of q) of r = ((to_poly a) ⊗⇘P⇙ q[^]⇘P⇙ n)of r"
using RHS0 by (metis P.nat_pow_closed P_def a_def
assms(2) monom_mult_is_smult to_polynomial_def)
have RHS2: "((ltrm f) of q) of r = ((to_poly a) of r) ⊗⇘P⇙ (q[^]⇘P⇙ n of r)"
using RHS1 a_def assms(2) assms(3) sub_mult to_poly_closed by auto
have RHS3: "((ltrm f) of q) of r = (to_poly a) ⊗⇘P⇙ (q[^]⇘P⇙ n of r)"
using RHS2 a_def assms(3) sub_to_poly by auto
have RHS4: "((ltrm f) of q) of r = a ⊙⇘P⇙ ((q[^]⇘P⇙ n)of r)"
using RHS3
by (metis P.nat_pow_closed P_def a_def assms(2) assms(3)
monom_mult_is_smult sub_closed to_polynomial_def)
have "(q of r)[^]⇘P⇙ n = ((q[^]⇘P⇙ n)of r)"
apply(induction n)
apply (metis Group.nat_pow_0 P.ring_simprules(6) assms(3) deg_one sub_const)
by (simp add: assms(2) assms(3) sub_mult)
then show ?thesis using RHS4 LHS by simp
qed
lemma sub_assoc:
assumes "f ∈ carrier P"
assumes "q ∈ carrier P"
assumes "r ∈ carrier P"
shows "f of (q of r) = (f of q) of r"
proof-
have "⋀ n. ⋀ p. p ∈ carrier P ⟹ degree p ≤ n ⟹ p of (q of r) = (p of q) of r"
proof-
fix n
show "⋀ p. p ∈ carrier P ⟹ degree p ≤ n ⟹ p of (q of r) = (p of q) of r"
proof(induction n)
case 0
then have deg_p: "degree p = 0"
by blast
then have B0: "p of (q of r) = p"
using sub_const[of "q of r" p] assms "0.prems"(1) sub_closed by blast
have B1: "(p of q) of r = p"
proof-
have p0: "p of q = p"
using deg_p 0 assms(2)
by (simp add: P_def UP_cring.sub_const UP_cring_axioms)
show ?thesis
unfolding p0 using deg_p 0 assms(3)
by (simp add: P_def UP_cring.sub_const UP_cring_axioms)
qed
then show "p of (q of r) = (p of q) of r" using B0 B1 by auto
next
case (Suc n)
fix n
assume IH: "⋀ p. p ∈ carrier P ⟹ degree p ≤ n ⟹ p of (q of r) = (p of q) of r"
then show "⋀ p. p ∈ carrier P ⟹ degree p ≤ Suc n ⟹ p of (q of r) = (p of q) of r"
proof-
fix p
assume A0: " p ∈ carrier P "
assume A1: "degree p ≤ Suc n"
show "p of (q of r) = (p of q) of r"
proof(cases "degree p < Suc n")
case True
then show ?thesis using A0 A1 IH by auto
next
case False
then have "degree p = Suc n"
using A1 by auto
have I0: "p of (q of r) = ((trunc p) ⊕⇘P⇙ (ltrm p)) of (q of r)"
using A0 trunc_simps(1) by auto
have I1: "p of (q of r) = ((trunc p) of (q of r)) ⊕⇘P⇙ ((ltrm p) of (q of r))"
using I0 sub_add
by (simp add: A0 assms(2) assms(3) ltrm_closed rev_sub_closed sub_rev_sub trunc_closed)
have I2: "p of (q of r) = (((trunc p) of q) of r) ⊕⇘P⇙ (((ltrm p) of q) of r)"
using IH[of "trunc p"] sub_assoc_monom[of p q r]
by (metis A0 I1 ‹degree p = Suc n› assms(2) assms(3)
less_Suc_eq_le trunc_degree trunc_closed zero_less_Suc)
have I3: "p of (q of r) = (((trunc p) of q) ⊕⇘P⇙ ((ltrm p) of q)) of r"
using sub_add trunc_simps(1) assms
by (simp add: A0 I2 ltrm_closed sub_closed trunc_closed)
have I4: "p of (q of r) = (((trunc p)⊕⇘P⇙(ltrm p)) of q) of r"
using sub_add trunc_simps(1) assms
by (simp add: trunc_simps(1) A0 I3 ltrm_closed trunc_closed)
then show ?thesis
using A0 trunc_simps(1) by auto
qed
qed
qed
qed
then show ?thesis
using assms(1) by blast
qed
lemma sub_smult:
assumes "f ∈ carrier P"
assumes "q ∈ carrier P"
assumes "a ∈ carrier R"
shows "(a⊙⇘P⇙f ) of q = a⊙⇘P⇙(f of q)"
proof-
have "(a⊙⇘P⇙f ) of q = ((to_poly a) ⊗⇘P⇙f) of q"
using assms by (metis P_def monom_mult_is_smult to_polynomial_def)
then have "(a⊙⇘P⇙f ) of q = ((to_poly a) of q) ⊗⇘P⇙(f of q)"
by (simp add: assms(1) assms(2) assms(3) sub_mult to_poly_closed)
then have "(a⊙⇘P⇙f ) of q = (to_poly a) ⊗⇘P⇙(f of q)"
by (simp add: assms(2) assms(3) sub_to_poly)
then show ?thesis
by (metis P_def assms(1) assms(2) assms(3)
monom_mult_is_smult sub_closed to_polynomial_def)
qed
lemma to_fun_sub_monom:
assumes "is_UP_monom f"
assumes "g ∈ carrier P"
assumes "a ∈ carrier R"
shows "to_fun (f of g) a = to_fun f (to_fun g a)"
proof-
obtain b n where b_def: "b ∈ carrier R ∧ f = monom P b n"
using assms unfolding is_UP_monom_def
using P_def cfs_closed by blast
then have P0: "f of g = b ⊙⇘P⇙ (g[^]⇘P⇙n)"
using b_def assms(2) monom_sub by blast
have P1: "UP_pre_univ_prop R R (λx. x)"
by (simp add: UP_pre_univ_prop_fact)
then have P2: "to_fun f (to_fun g a) = b ⊗((to_fun g a)[^]n)"
using P1 to_fun_eval[of f "to_fun g a"] P_def UP_pre_univ_prop.eval_monom assms(1)
assms(2) assms(3) b_def is_UP_monomE(1) to_fun_closed
by force
have P3: "to_fun (monom P b n of g) a = b ⊗((to_fun g a)[^]n)"
proof-
have 0: "to_fun (monom P b n of g) a = eval R R (λx. x) a (b ⊙⇘P⇙ (g[^]⇘P⇙n) )"
using UP_pre_univ_prop.eval_monom[of R "(UP R)" to_poly b g n]
P_def assms(2) b_def to_poly_UP_pre_univ_prop to_fun_eval P0
by (metis assms(3) monom_closed sub_closed)
have 1: "to_fun (monom P b n of g) a = (eval R R (λx. x) a (to_poly b)) ⊗ ( eval R R (λx. x) a ( g [^]⇘UP R⇙ n ))"
using 0 eval_ring_hom
by (metis P.nat_pow_closed P0 P_def assms(2) assms(3) b_def monom_mult_is_smult to_fun_eval to_fun_mult to_poly_closed to_polynomial_def)
have 2: "to_fun (monom P b n of g) a = b ⊗ ( eval R R (λx. x) a ( g [^]⇘UP R⇙ n ))"
using 1 assms(3) b_def to_fun_eval to_fun_to_poly to_poly_closed by auto
then show ?thesis
unfolding to_function_def to_fun_def
using eval_ring_hom P_def UP_pre_univ_prop.ring_homD UP_pre_univ_prop_fact
assms(2) assms(3) ring_hom_cring.hom_pow by fastforce
qed
then show ?thesis
using b_def P2 by auto
qed
lemma to_fun_sub:
assumes "g ∈ carrier P"
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "to_fun (f of g) a = (to_fun f) (to_fun g a)"
proof(rule poly_induct2[of f])
show "f ∈ carrier P"
using assms by auto
show "⋀p. p ∈ carrier P ⟹ degree p = 0 ⟹ to_fun (p of g) a = to_fun p (to_fun g a)"
proof-
fix p
assume A0: "p ∈ carrier P"
assume A1: "degree p = 0"
then have P0: "degree (p of g) = 0"
by (simp add: A0 assms(1) sub_const)
then obtain b where b_def: "p of g = to_poly b ∧ b ∈ carrier R"
using A0 A1 cfs_closed assms(1) to_poly_inverse
by (meson sub_closed)
then have "to_fun (p of g) a = b"
by (simp add: assms(3) to_fun_to_poly)
have "p of g = p"
using A0 A1 P_def sub_const UP_cring_axioms assms(1) by blast
then have P1: "p = to_poly b"
using b_def by auto
have "to_fun g a ∈ carrier R"
using assms
by (simp add: to_fun_closed)
then show "to_fun (p of g) a = to_fun p (to_fun g a)"
using P1 ‹to_fun (p of g) a = b› b_def
by (simp add: to_fun_to_poly)
qed
show "⋀p. 0 < degree p ⟹ p ∈ carrier P ⟹
to_fun (trunc p of g) a = to_fun (trunc p) (to_fun g a) ⟹
to_fun (p of g) a = to_fun p (to_fun g a)"
proof-
fix p
assume A0: "0 < degree p"
assume A1: " p ∈ carrier P"
assume A2: "to_fun (trunc p of g) a = to_fun (trunc p) (to_fun g a)"
show "to_fun (p of g) a = to_fun p (to_fun g a)"
proof-
have "p of g = (trunc p) of g ⊕⇘P⇙ (ltrm p) of g"
by (metis A1 assms(1) ltrm_closed sub_add trunc_simps(1) trunc_closed)
then have "to_fun (p of g) a = to_fun ((trunc p) of g) a ⊕ (to_fun ((ltrm p) of g) a)"
by (simp add: A1 assms(1) assms(3) to_fun_plus ltrm_closed sub_closed trunc_closed)
then have 0: "to_fun (p of g) a = to_fun (trunc p) (to_fun g a) ⊕ (to_fun ((ltrm p) of g) a)"
by (simp add: A2)
have "(to_fun ((ltrm p) of g) a) = to_fun (ltrm p) (to_fun g a)"
using to_fun_sub_monom
by (simp add: A1 assms(1) assms(3) ltrm_is_UP_monom)
then have "to_fun (p of g) a = to_fun (trunc p) (to_fun g a) ⊕ to_fun (ltrm p) (to_fun g a)"
using 0 by auto
then show ?thesis
by (metis A1 assms(1) assms(3) to_fun_closed to_fun_plus ltrm_closed trunc_simps(1) trunc_closed)
qed
qed
qed
end
text‹More material on constant terms and constant coefficients›
context UP_cring
begin
lemma to_fun_ctrm:
assumes "f ∈ carrier P"
assumes "b ∈ carrier R"
shows "to_fun (ctrm f) b = (f 0)"
using assms
by (metis ctrm_degree ctrm_is_poly lcf_monom(2) P_def cfs_closed to_fun_to_poly to_poly_inverse)
lemma to_fun_smult:
assumes "f ∈ carrier P"
assumes "b ∈ carrier R"
assumes "c ∈ carrier R"
shows "to_fun (c ⊙⇘P⇙ f) b = c ⊗(to_fun f b)"
proof-
have "(c ⊙⇘P⇙ f) = (to_poly c) ⊗⇘P⇙ f"
by (metis P_def assms(1) assms(3) monom_mult_is_smult to_polynomial_def)
then have "to_fun (c ⊙⇘P⇙ f) b = to_fun (to_poly c) b ⊗ to_fun f b"
by (simp add: assms(1) assms(2) assms(3) to_fun_mult to_poly_closed)
then show ?thesis
by (simp add: assms(2) assms(3) to_fun_to_poly)
qed
lemma to_fun_monom:
assumes "c ∈ carrier R"
assumes "x ∈ carrier R"
shows "to_fun (monom P c n) x = c ⊗ x [^] n"
by (smt P_def R.m_comm R.nat_pow_closed UP_cring.to_poly_nat_pow UP_cring_axioms assms(1)
assms(2) monom_is_UP_monom(1) sub_monom(1) to_fun_smult to_fun_sub_monom to_fun_to_poly
to_poly_closed to_poly_mult_simp(2))
lemma zcf_monom:
assumes "a ∈ carrier R"
shows "zcf (monom P a n) = to_fun (monom P a n) 𝟬"
using to_fun_monom unfolding zcf_def
by (simp add: R.nat_pow_zero assms cfs_monom)
lemma zcf_to_fun:
assumes "p ∈ carrier P"
shows "zcf p = to_fun p 𝟬"
apply(rule poly_induct3[of p])
apply (simp add: assms)
using R.zero_closed zcf_add to_fun_plus apply presburger
using zcf_monom by blast
lemma zcf_to_poly[simp]:
assumes "a ∈ carrier R"
shows "zcf (to_poly a) = a"
by (metis assms cfs_closed degree_to_poly to_fun_to_poly to_poly_inverse to_poly_closed zcf_def)
lemma zcf_ltrm_mult:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "degree p > 0"
shows "zcf((ltrm p) ⊗⇘P⇙ q) = 𝟬"
using zcf_to_fun[of "ltrm p ⊗⇘P⇙ q" ]
by (metis ltrm_closed P.l_null P.m_closed R.zero_closed UP_zero_closed zcf_to_fun
zcf_zero assms(1) assms(2) assms(3) coeff_ltrm to_fun_mult)
lemma zcf_mult:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
shows "zcf(p ⊗⇘P⇙ q) = (zcf p) ⊗ (zcf q)"
using zcf_to_fun[of " p ⊗⇘P⇙ q" ] zcf_to_fun[of "p" ] zcf_to_fun[of "q" ] to_fun_mult[of q p 𝟬]
by (simp add: assms(1) assms(2))
lemma zcf_is_ring_hom:
"zcf∈ ring_hom P R"
apply(rule ring_hom_memI)
using zcf_mult zcf_add
apply (simp add: P_def UP_ring.cfs_closed UP_ring_axioms zcf_def)
apply (simp add: zcf_mult)
using zcf_add apply auto[1]
by simp
lemma ctrm_is_ring_hom:
"ctrm ∈ ring_hom P P"
apply(rule ring_hom_memI)
apply (simp add: ctrm_is_poly)
apply (metis zcf_def zcf_mult cfs_closed monom_mult zero_eq_add_iff_both_eq_0)
using cfs_add[of _ _ 0]
apply (simp add: cfs_closed)
by auto
section‹Describing the Image of (UP R) in the Ring of Functions from R to R›
lemma to_fun_diff:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "a ∈ carrier R"
shows "to_fun (p ⊖⇘P⇙ q) a = to_fun p a ⊖ to_fun q a"
using to_fun_plus[of "⊖⇘P⇙ q" p a]
by (simp add: P.minus_eq R.minus_eq assms(1) assms(2) assms(3) to_fun_minus)
lemma to_fun_const:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "to_fun (monom P a 0) b = a"
by (metis lcf_monom(2) P_def UP_cring.to_fun_ctrm UP_cring_axioms assms(1) assms(2) deg_const monom_closed)
lemma to_fun_monic_monom:
assumes "b ∈ carrier R"
shows "to_fun (monom P 𝟭 n) b = b[^]n"
by (simp add: assms to_fun_monom)
text‹Constant polynomials map to constant polynomials›
lemma const_to_constant:
assumes "a ∈ carrier R"
shows "to_fun (monom P a 0) = constant_function (carrier R) a"
apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
unfolding ring_functions_def apply(simp add: R.ring_axioms)
apply (simp add: assms to_fun_is_Fun)
using assms ring_functions.constant_function_closed[of R a "carrier R"]
unfolding ring_functions_def apply (simp add: R.ring_axioms)
using assms to_fun_const[of a ] unfolding constant_function_def
by auto
text‹Monomial polynomials map to monomial functions›
lemma monom_to_monomial:
assumes "a ∈ carrier R"
shows "to_fun (monom P a n) = monomial_function R a n"
apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
unfolding ring_functions_def apply(simp add: R.ring_axioms)
apply (simp add: assms to_fun_is_Fun)
using assms U_function_ring.monomial_functions[of R a n] R.ring_axioms
unfolding U_function_ring_def
apply auto[1]
unfolding monomial_function_def
using assms to_fun_monom[of a _ n]
by auto
end
section‹Taylor Expansions›
subsection‹Monic Linear Polynomials›
text‹The polynomial representing the variable X›
definition X_poly where
"X_poly R = monom (UP R) 𝟭⇘R⇙ 1"
context UP_cring
begin
abbreviation(input) X where
"X ≡ X_poly R"
lemma X_closed:
"X ∈ carrier P"
unfolding X_poly_def
using P_def monom_closed by blast
lemma degree_X[simp]:
assumes "𝟭 ≠𝟬"
shows"degree X = 1"
unfolding X_poly_def
using assms P_def deg_monom[of 𝟭 1]
by blast
lemma X_not_zero:
assumes "𝟭 ≠𝟬"
shows"X ≠ 𝟬⇘P⇙"
using degree_X assms by force
lemma sub_X[simp]:
assumes "p ∈ carrier P"
shows "X of p = p"
unfolding X_poly_def
using P_def UP_pre_univ_prop.eval_monom1 assms compose_def to_poly_UP_pre_univ_prop
by metis
lemma sub_monom_deg_one:
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
shows "monom P a 1 of p = a ⊙⇘P⇙ p"
using assms sub_smult[of X p a] unfolding X_poly_def
by (metis P_def R.one_closed R.r_one X_closed X_poly_def monom_mult_smult sub_X)
lemma monom_rep_X_pow:
assumes "a ∈ carrier R"
shows "monom P a n = a⊙⇘P⇙(X[^]⇘P⇙n)"
proof-
have "monom P a n = a⊙⇘P⇙monom P 𝟭 n"
by (metis R.one_closed R.r_one assms monom_mult_smult)
then show ?thesis
unfolding X_poly_def
using monom_pow
by (simp add: P_def)
qed
lemma X_sub[simp]:
assumes "p ∈ carrier P"
shows "p of X = p"
apply(rule poly_induct3)
apply (simp add: assms)
using X_closed sub_add apply presburger
using sub_monom[of X] P_def monom_rep_X_pow X_closed by auto
text‹representation of monomials as scalar multiples of powers of X›
lemma ltrm_rep_X_pow:
assumes "p ∈ carrier P"
shows "ltrm p = (lcf p)⊙⇘P⇙(X[^]⇘P⇙(degree p))"
proof-
have "ltrm p = monom P (lcf p) (degree p)"
using assms unfolding leading_term_def by (simp add: P_def)
then show ?thesis
using monom_rep_X_pow P_def assms
by (simp add: cfs_closed)
qed
lemma to_fun_monom':
assumes "c ∈ carrier R"
assumes "c ≠𝟬"
assumes "x ∈ carrier R"
shows "to_fun (c ⊙⇘P⇙ X[^]⇘P⇙(n::nat)) x = c ⊗ x [^] n"
using P_def to_fun_monom monom_rep_X_pow UP_cring_axioms assms(1) assms(2) assms(3) by fastforce
lemma to_fun_X_pow:
assumes "x ∈ carrier R"
shows "to_fun (X[^]⇘P⇙(n::nat)) x = x [^] n"
using to_fun_monom'[of 𝟭 x n] assms
by (metis P.nat_pow_closed R.l_one R.nat_pow_closed R.one_closed R.r_null R.r_one
UP_one_closed X_closed to_fun_to_poly ring_hom_one smult_l_null smult_one to_poly_is_ring_hom)
end
text‹Monic linear polynomials›
definition X_poly_plus where
"X_poly_plus R a = (X_poly R) ⊕⇘(UP R)⇙ to_polynomial R a"
definition X_poly_minus where
"X_poly_minus R a = (X_poly R) ⊖⇘(UP R)⇙ to_polynomial R a"
context UP_cring
begin
abbreviation(input) X_plus where
"X_plus ≡ X_poly_plus R"
abbreviation(input) X_minus where
"X_minus ≡ X_poly_minus R"
lemma X_plus_closed:
assumes "a ∈ carrier R"
shows "(X_plus a) ∈ carrier P"
unfolding X_poly_plus_def using X_closed to_poly_closed
using P_def UP_a_closed assms by auto
lemma X_minus_closed:
assumes "a ∈ carrier R"
shows "(X_minus a) ∈ carrier P"
unfolding X_poly_minus_def using X_closed to_poly_closed
by (simp add: P_def UP_cring.UP_cring UP_cring_axioms assms cring.cring_simprules(4))
lemma X_minus_plus:
assumes "a ∈ carrier R"
shows "(X_minus a) = X_plus (⊖a)"
using P_def UP_ring.UP_ring UP_ring_axioms
by (simp add: X_poly_minus_def X_poly_plus_def a_minus_def assms to_poly_a_inv)
lemma degree_of_X_plus:
assumes "a ∈ carrier R"
assumes "𝟭 ≠𝟬"
shows "degree (X_plus a) = 1"
proof-
have 0:"degree (X_plus a) ≤ 1"
using deg_add degree_X P_def unfolding X_poly_plus_def
using UP_cring.to_poly_closed UP_cring_axioms X_closed assms(1) assms(2) by fastforce
have 1:"degree (X_plus a) > 0"
by (metis One_nat_def P_def R.one_closed R.r_zero X_poly_def
X_closed X_poly_plus_def X_plus_closed assms coeff_add coeff_monom deg_aboveD
gr0I lessI n_not_Suc_n to_polynomial_def to_poly_closed)
then show ?thesis
using "0" by linarith
qed
lemma degree_of_X_minus:
assumes "a ∈ carrier R"
assumes "𝟭 ≠𝟬"
shows "degree (X_minus a) = 1"
using degree_of_X_plus[of "⊖a"] X_minus_plus[simp] assms by auto
lemma ltrm_of_X:
shows"ltrm X = X"
unfolding leading_term_def
by (metis P_def R.one_closed X_poly_def is_UP_monom_def is_UP_monomI leading_term_def)
lemma ltrm_of_X_plus:
assumes "a ∈ carrier R"
assumes "𝟭 ≠𝟬"
shows "ltrm (X_plus a) = X"
unfolding X_poly_plus_def
using X_closed assms ltrm_of_sum_diff_degree[of X "to_poly a"]
degree_to_poly[of a] to_poly_closed[of a] degree_X ltrm_of_X
by (simp add: P_def)
lemma ltrm_of_X_minus:
assumes "a ∈ carrier R"
assumes "𝟭 ≠𝟬"
shows "ltrm (X_minus a) = X"
using X_minus_plus[of a] assms
by (simp add: ltrm_of_X_plus)
lemma lcf_of_X_minus:
assumes "a ∈ carrier R"
assumes "𝟭 ≠𝟬"
shows "lcf (X_minus a) = 𝟭"
using ltrm_of_X_minus unfolding X_poly_def
using P_def UP_cring.X_minus_closed UP_cring.lcf_eq UP_cring_axioms assms(1) assms(2) lcf_monom
by (metis R.one_closed)
lemma lcf_of_X_plus:
assumes "a ∈ carrier R"
assumes "𝟭 ≠𝟬"
shows "lcf (X_plus a) = 𝟭"
using ltrm_of_X_plus unfolding X_poly_def
by (metis lcf_of_X_minus P_def UP_cring.lcf_eq UP_cring.X_plus_closed UP_cring_axioms X_minus_closed assms(1) assms(2) degree_of_X_minus)
lemma to_fun_X[simp]:
assumes "a ∈ carrier R"
shows "to_fun X a = a"
using X_closed assms to_fun_sub_monom ltrm_is_UP_monom ltrm_of_X to_poly_closed
by (metis sub_X to_fun_to_poly)
lemma to_fun_X_plus[simp]:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "to_fun (X_plus a) b = b ⊕ a"
unfolding X_poly_plus_def
using assms to_fun_X[of b] to_fun_plus[of "to_poly a" X b] to_fun_to_poly[of a b]
using P_def X_closed to_poly_closed by auto
lemma to_fun_X_minus[simp]:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "to_fun (X_minus a) b = b ⊖ a"
using to_fun_X_plus[of "⊖ a" b] X_minus_plus[of a] assms
by (simp add: R.minus_eq)
lemma cfs_X_plus:
assumes "a ∈ carrier R"
shows "X_plus a n = (if n = 0 then a else (if n = 1 then 𝟭 else 𝟬))"
using assms cfs_add monom_closed UP_ring_axioms cfs_monom
unfolding X_poly_plus_def to_polynomial_def X_poly_def P_def
by auto
lemma cfs_X_minus:
assumes "a ∈ carrier R"
shows "X_minus a n = (if n = 0 then ⊖ a else (if n = 1 then 𝟭 else 𝟬))"
using cfs_X_plus[of "⊖ a"] assms
unfolding X_poly_plus_def X_poly_minus_def
by (simp add: P_def a_minus_def to_poly_a_inv)
text‹Linear substituions›
lemma X_plus_sub_deg:
assumes "a ∈ carrier R"
assumes "f ∈ carrier P"
shows "degree (f of (X_plus a)) = degree f"
apply(cases "𝟭 = 𝟬")
apply (metis P_def UP_one_closed X_plus_closed X_poly_def sub_X assms(1) assms(2) deg_one monom_one monom_zero sub_const)
using cring_sub_deg[of "X_plus a" f] assms X_plus_closed[of a] lcf_of_X_plus[of a]
ltrm_of_X_plus degree_of_X_plus[of a] P_def
by (metis lcf_eq R.nat_pow_one R.r_one UP_cring.cring_sub_deg UP_cring_axioms X_closed X_sub
cfs_closed coeff_simp deg_nzero_nzero degree_X lcoeff_nonzero2 sub_const)
lemma X_minus_sub_deg:
assumes "a ∈ carrier R"
assumes "f ∈ carrier P"
shows "degree (f of (X_minus a)) = degree f"
using X_plus_sub_deg[of "⊖a"] assms X_minus_plus[of a]
by simp
lemma plus_minus_sub:
assumes " a ∈ carrier R"
shows "X_plus a of X_minus a = X"
unfolding X_poly_plus_def
proof-
have "(X ⊕⇘P⇙ to_poly a) of X_minus a = (X of X_minus a) ⊕⇘P⇙ (to_poly a) of X_minus a"
using sub_add
by (simp add: X_closed X_minus_closed assms to_poly_closed)
then have "(X ⊕⇘P⇙ to_poly a) of X_minus a = (X_minus a) ⊕⇘P⇙ (to_poly a)"
by (simp add: X_minus_closed assms sub_to_poly)
then show "(X ⊕⇘UP R⇙ to_poly a) of X_minus a = X"
unfolding to_polynomial_def X_poly_minus_def
by (metis P.add.inv_solve_right P.minus_eq P_def
X_closed X_poly_minus_def X_minus_closed assms monom_closed to_polynomial_def)
qed
lemma minus_plus_sub:
assumes " a ∈ carrier R"
shows "X_minus a of X_plus a = X"
using plus_minus_sub[of "⊖a"]
unfolding X_poly_minus_def
unfolding X_poly_plus_def
using assms apply simp
by (metis P_def R.add.inv_closed R.minus_minus a_minus_def to_poly_a_inv)
lemma ltrm_times_X:
assumes "p ∈ carrier P"
shows "ltrm (X ⊗⇘P⇙ p) = X ⊗⇘P⇙ (ltrm p)"
using assms ltrm_of_X cring_ltrm_mult[of X p]
by (metis ltrm_deg_0 P.r_null R.l_one R.one_closed UP_cring.lcf_monom(1)
UP_cring_axioms X_closed X_poly_def cfs_closed deg_zero deg_ltrm monom_zero)
lemma times_X_not_zero:
assumes "p ∈ carrier P"
assumes "p ≠ 𝟬⇘P⇙"
shows "(X ⊗⇘P⇙ p) ≠ 𝟬⇘P⇙"
by (metis (no_types, hide_lams) lcf_monom(1) lcf_of_X_minus ltrm_of_X_minus P.inv_unique
P.r_null R.l_one R.one_closed UP_zero_closed X_closed zcf_def
zcf_zero_degree_zero assms(1) assms(2) cfs_closed cfs_zero cring_lcf_mult
deg_monom deg_nzero_nzero deg_ltrm degree_X degree_of_X_minus
monom_one monom_zero)
lemma degree_times_X:
assumes "p ∈ carrier P"
assumes "p ≠ 𝟬⇘P⇙"
shows "degree (X ⊗⇘P⇙ p) = degree p + 1"
using cring_deg_mult[of X p] assms times_X_not_zero[of p]
by (metis (no_types, lifting) P.r_null P.r_one P_def R.l_one R.one_closed
UP_cring.lcf_monom(1) UP_cring_axioms UP_zero_closed X_closed X_poly_def cfs_closed
deg_zero deg_ltrm degree_X monom_one monom_zero to_poly_inverse)
end
subsection‹Basic Facts About Taylor Expansions›
definition taylor_expansion where
"taylor_expansion R a p = compose R p (X_poly_plus R a)"
definition(in UP_cring) taylor where
"taylor ≡ taylor_expansion R"
context UP_cring
begin
lemma taylor_expansion_ring_hom:
assumes "c ∈ carrier R"
shows "taylor_expansion R c ∈ ring_hom P P"
unfolding taylor_expansion_def
using rev_sub_is_hom[of "X_plus c"]
unfolding rev_compose_def compose_def
using X_plus_closed assms by auto
notation taylor ("T⇘_⇙")
lemma(in UP_cring) taylor_closed:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "T⇘a⇙ f ∈ carrier P"
unfolding taylor_def
by (simp add: X_plus_closed assms(1) assms(2) sub_closed taylor_expansion_def)
lemma taylor_deg:
assumes "a ∈ carrier R"
assumes "p ∈ carrier P"
shows "degree (T⇘a⇙ p) = degree p"
unfolding taylor_def taylor_expansion_def
using X_plus_sub_deg[of a p] assms
by (simp add: taylor_expansion_def)
lemma taylor_id:
assumes "a ∈ carrier R"
assumes "p ∈ carrier P"
shows "p = (T⇘a⇙ p) of (X_minus a)"
unfolding taylor_expansion_def taylor_def
using assms sub_assoc[of p "X_plus a" "X_minus a"] X_plus_closed[of a] X_minus_closed[of a]
by (metis X_sub plus_minus_sub taylor_expansion_def)
lemma taylor_eval:
assumes "a ∈ carrier R"
assumes "f ∈ carrier P"
assumes "b ∈ carrier R"
shows "to_fun (T⇘a⇙ f) b = to_fun f (b ⊕ a)"
unfolding taylor_expansion_def taylor_def
using to_fun_sub[of "(X_plus a)" f b] to_fun_X_plus[of a b]
assms X_plus_closed[of a] by auto
lemma taylor_eval':
assumes "a ∈ carrier R"
assumes "f ∈ carrier P"
assumes "b ∈ carrier R"
shows "to_fun f (b) = to_fun (T⇘a⇙ f) (b ⊖ a) "
unfolding taylor_expansion_def taylor_def
using to_fun_sub[of "(X_minus a)" "T⇘a⇙ f" b] to_fun_X_minus[of b a]
assms X_minus_closed[of a]
by (metis taylor_closed taylor_def taylor_id taylor_expansion_def to_fun_X_minus)
lemma(in UP_cring) degree_monom:
assumes "a ∈ carrier R"
shows "degree (a ⊙⇘UP R⇙ (X_poly R)[^]⇘UP R⇙n) = (if a = 𝟬 then 0 else n)"
apply(cases "a = 𝟬")
apply (metis (full_types) P.nat_pow_closed P_def R.one_closed UP_smult_zero X_poly_def deg_zero monom_closed)
using P_def UP_cring.monom_rep_X_pow UP_cring_axioms assms deg_monom by fastforce
lemma(in UP_cring) poly_comp_finsum:
assumes "⋀i::nat. i ≤ n ⟹ g i ∈ carrier P"
assumes "q ∈ carrier P"
assumes "p = (⨁⇘P⇙ i ∈ {..n}. g i)"
shows "p of q = (⨁⇘P⇙ i ∈ {..n}. (g i) of q)"
proof-
have 0: "p of q = rev_sub q p"
unfolding compose_def rev_compose_def by blast
have 1: "p of q = finsum P (rev_compose R q ∘ g) {..n}"
unfolding 0 unfolding assms
apply(rule ring_hom_finsum[of "rev_compose R q" P "{..n}" g ])
using assms(2) rev_sub_is_hom apply blast
apply (simp add: UP_ring)
apply simp
by (simp add: assms(1))
show ?thesis unfolding 1
unfolding comp_apply rev_compose_def compose_def
by auto
qed
lemma(in UP_cring) poly_comp_expansion:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "degree p ≤ n"
shows "p of q = (⨁⇘P⇙ i ∈ {..n}. (p i) ⊙⇘P⇙ q[^]⇘P⇙i)"
proof-
obtain g where g_def: "g = (λi. monom P (p i) i)"
by blast
have 0: "⋀i. (g i) of q = (p i) ⊙⇘P⇙ q[^]⇘P⇙i"
proof- fix i show "g i of q = p i ⊙⇘P⇙ q [^]⇘P⇙ i"
using assms g_def P_def coeff_simp monom_sub
by (simp add: cfs_closed)
qed
have 1: "(⋀i. i ≤ n ⟹ g i ∈ carrier P)"
using g_def assms
by (simp add: cfs_closed)
have "(⨁⇘P⇙i∈{..n}. monom P (p i) i) = p"
using assms up_repr_le[of p n] coeff_simp[of p] unfolding P_def
by auto
then have "p = (⨁⇘P⇙ i ∈ {..n}. g i)"
using g_def by auto
then have "p of q = (⨁⇘P⇙i∈{..n}. g i of q)"
using 0 1 poly_comp_finsum[of n g q p]
using assms(2)
by blast
then show ?thesis
by(simp add: 0)
qed
lemma(in UP_cring) taylor_sum:
assumes "p ∈ carrier P"
assumes "degree p ≤ n"
assumes "a ∈ carrier R"
shows "p = (⨁⇘P⇙ i ∈ {..n}. T⇘a⇙ p i ⊙⇘P⇙ (X_minus a)[^]⇘P⇙i)"
proof-
have 0: "(T⇘a⇙ p) of X_minus a = p"
using P_def taylor_id assms(1) assms(3)
by fastforce
have 1: "degree (T⇘a⇙ p) ≤ n"
using assms
by (simp add: taylor_deg)
have 2: "T⇘a⇙ p of X_minus a = (⨁⇘P⇙i∈{..n}. T⇘a⇙ p i ⊙⇘P⇙ X_minus a [^]⇘P⇙ i)"
using 1 X_minus_closed[of a] poly_comp_expansion[of "T⇘a⇙ p" "X_minus a" n]
assms taylor_closed
by blast
then show ?thesis
using 0
by simp
qed
text‹The $i^{th}$ term in the taylor expansion›
definition taylor_term where
"taylor_term c p i = (taylor_expansion R c p i) ⊙⇘UP R⇙ (UP_cring.X_minus R c) [^]⇘UP R⇙i"
lemma (in UP_cring) taylor_term_closed:
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
shows "taylor_term a p i ∈ carrier (UP R)"
unfolding taylor_term_def
using P.nat_pow_closed P_def taylor_closed taylor_def X_minus_closed assms(1) assms(2) smult_closed
by (simp add: cfs_closed)
lemma(in UP_cring) taylor_term_sum:
assumes "p ∈ carrier P"
assumes "degree p ≤ n"
assumes "a ∈ carrier R"
shows "p = (⨁⇘P⇙ i ∈ {..n}. taylor_term a p i)"
unfolding taylor_term_def taylor_def
using assms taylor_sum[of p n a] P_def
using taylor_def by auto
lemma (in UP_cring) taylor_expansion_add:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "c ∈ carrier R"
shows "taylor_expansion R c (p ⊕⇘UP R⇙ q) = (taylor_expansion R c p) ⊕⇘UP R⇙ (taylor_expansion R c q)"
unfolding taylor_expansion_def
using assms X_plus_closed[of c] P_def sub_add
by blast
lemma (in UP_cring) taylor_term_add:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "a ∈ carrier R"
shows "taylor_term a (p ⊕⇘UP R⇙q) i = taylor_term a p i ⊕⇘UP R⇙ taylor_term a q i"
using assms taylor_expansion_add[of p q a]
unfolding taylor_term_def
using P.nat_pow_closed P_def taylor_closed X_minus_closed cfs_add smult_l_distr
by (simp add: taylor_def cfs_closed)
lemma (in UP_cring) to_fun_taylor_term:
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
assumes "c ∈ carrier R"
shows "to_fun (taylor_term c p i) a = (T⇘c⇙ p i) ⊗ (a ⊖ c)[^]i"
using assms to_fun_smult[of "X_minus c [^]⇘UP R⇙ i" a "taylor_expansion R c p i"]
to_fun_X_minus[of c a] to_fun_nat_pow[of "X_minus c" a i]
unfolding taylor_term_def
using P.nat_pow_closed P_def taylor_closed taylor_def X_minus_closed
by (simp add: cfs_closed)
end
subsection‹Defining the (Scalar-Valued) Derivative of a Polynomial Using the Taylor Expansion›
definition derivative where
"derivative R f a = (taylor_expansion R a f) 1"
context UP_cring
begin
abbreviation(in UP_cring) deriv where
"deriv ≡ derivative R"
lemma(in UP_cring) deriv_closed:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "(derivative R f a) ∈ carrier R"
unfolding derivative_def
using taylor_closed taylor_def assms(1) assms(2) cfs_closed by auto
lemma(in UP_cring) deriv_add:
assumes "f ∈ carrier P"
assumes "g ∈ carrier P"
assumes "a ∈ carrier R"
shows "deriv (f ⊕⇘P⇙ g) a = deriv f a ⊕ deriv g a"
unfolding derivative_def taylor_expansion_def using assms
by (simp add: X_plus_closed sub_add sub_closed)
end
section‹The Polynomial-Valued Derivative Operator›
context UP_cring
begin
subsection‹Operator Which Shifts Coefficients›
lemma cfs_times_X:
assumes "g ∈ carrier P"
shows "(X ⊗⇘P⇙ g) (Suc n) = g n"
apply(rule poly_induct3[of g])
apply (simp add: assms)
apply (metis (no_types, lifting) P.m_closed P.r_distr X_closed cfs_add)
by (metis (no_types, lifting) P_def R.l_one R.one_closed R.r_null Suc_eq_plus1 X_poly_def
cfs_monom coeff_monom_mult coeff_simp monom_closed monom_mult)
lemma times_X_pow_coeff:
assumes "g ∈ carrier P"
shows "(monom P 𝟭 k ⊗⇘P⇙ g) (n + k) = g n"
using coeff_monom_mult P.m_closed P_def assms coeff_simp monom_closed
by (simp add: cfs_closed)
lemma zcf_eq_zero_unique:
assumes "f ∈ carrier P"
assumes "g ∈ carrier P ∧ (f = X ⊗⇘P⇙ g)"
shows "⋀ h. h ∈ carrier P ∧ (f = X ⊗⇘P⇙ h) ⟹ h = g"
proof-
fix h
assume A: "h ∈ carrier P ∧ (f = X ⊗⇘P⇙ h)"
then have 0: " X ⊗⇘P⇙ g = X ⊗⇘P⇙ h"
using assms(2) by auto
show "h = g"
using 0 A assms
by (metis P_def coeff_simp cfs_times_X up_eqI)
qed
lemma f_minus_ctrm:
assumes "f ∈ carrier P"
shows "zcf(f ⊖⇘P⇙ ctrm f) = 𝟬"
using assms
by (smt ctrm_is_poly P.add.inv_closed P.minus_closed P_def R.r_neg R.zero_closed zcf_to_fun
to_fun_minus to_fun_plus UP_cring_axioms zcf_ctrm zcf_def a_minus_def cfs_closed)
definition poly_shift where
"poly_shift f n = f (Suc n)"
lemma poly_shift_closed:
assumes "f ∈ carrier P"
shows "poly_shift f ∈ carrier P"
apply(rule UP_car_memI[of "deg R f"])
unfolding poly_shift_def
proof -
fix n :: nat
assume "deg R f < n"
then have "deg R f < Suc n"
using Suc_lessD by blast
then have "f (Suc n) = 𝟬⇘P⇙ (Suc n)"
by (metis P.l_zero UP_zero_closed assms coeff_of_sum_diff_degree0)
then show "f (Suc n) = 𝟬"
by simp
next
show " ⋀n. f (Suc n) ∈ carrier R"
by(rule cfs_closed, rule assms)
qed
lemma poly_shift_eq_0:
assumes "f ∈ carrier P"
shows "f n = (ctrm f ⊕⇘P⇙ X ⊗⇘P⇙ poly_shift f) n"
apply(cases "n = 0")
apply (smt ctrm_degree ctrm_is_poly ltrm_of_X One_nat_def P.r_null P.r_zero P_def UP_cring.lcf_monom(1) UP_cring_axioms UP_mult_closed UP_r_one UP_zero_closed X_closed zcf_ltrm_mult zcf_def zcf_zero assms cfs_add cfs_closed deg_zero degree_X lessI monom_one poly_shift_closed to_poly_inverse)
proof- assume A: "n ≠ 0"
then obtain k where k_def: " n = Suc k"
by (meson lessI less_Suc_eq_0_disj)
show ?thesis
using cfs_times_X[of "poly_shift f" k] poly_shift_def[of f k] poly_shift_closed assms
cfs_add[of "ctrm f" "X ⊗⇘P⇙ poly_shift f" n] unfolding k_def
by (simp add: X_closed cfs_closed cfs_monom)
qed
lemma poly_shift_eq:
assumes "f ∈ carrier P"
shows "f = (ctrm f ⊕⇘P⇙ X ⊗⇘P⇙ poly_shift f)"
by(rule ext, rule poly_shift_eq_0, rule assms)
lemma poly_shift_id:
assumes "f ∈ carrier P"
shows "f ⊖⇘P⇙ ctrm f = X ⊗⇘P⇙ poly_shift f"
using assms poly_shift_eq[of f] poly_shift_closed unfolding a_minus_def
by (metis ctrm_is_poly P.add.inv_solve_left P.m_closed UP_a_comm UP_a_inv_closed X_closed)
lemma poly_shift_degree_zero:
assumes "p ∈ carrier P"
assumes "degree p = 0"
shows "poly_shift p = 𝟬⇘P⇙"
by (metis ltrm_deg_0 P.r_neg P.r_null UP_ring UP_zero_closed X_closed zcf_eq_zero_unique
abelian_group.minus_eq assms(1) assms(2) poly_shift_closed poly_shift_id ring_def)
lemma poly_shift_degree:
assumes "p ∈ carrier P"
assumes "degree p > 0"
shows "degree (poly_shift p) = degree p - 1 "
using poly_shift_id[of p]
by (metis ctrm_degree ctrm_is_poly P.r_null X_closed add_diff_cancel_right' assms(1) assms(2)
deg_zero degree_of_difference_diff_degree degree_times_X nat_less_le poly_shift_closed)
lemma poly_shift_monom:
assumes "a ∈ carrier R"
shows "poly_shift (monom P a (Suc k)) = (monom P a k)"
proof-
have "(monom P a (Suc k)) = ctrm (monom P a (Suc k)) ⊕⇘P⇙ X ⊗⇘P⇙poly_shift (monom P a (Suc k))"
using poly_shift_eq[of "monom P a (Suc k)"] assms monom_closed
by blast
then have "(monom P a (Suc k)) = 𝟬⇘P⇙ ⊕⇘P⇙ X ⊗⇘P⇙poly_shift (monom P a (Suc k))"
using assms by simp
then have "(monom P a (Suc k)) = X ⊗⇘P⇙poly_shift (monom P a (Suc k))"
using X_closed assms poly_shift_closed by auto
then have "X ⊗⇘P⇙(monom P a k) = X ⊗⇘P⇙poly_shift (monom P a (Suc k))"
by (metis P_def R.l_one R.one_closed X_poly_def assms monom_mult plus_1_eq_Suc)
then show ?thesis
using X_closed X_not_zero assms
by (meson UP_mult_closed zcf_eq_zero_unique monom_closed poly_shift_closed)
qed
lemma(in UP_cring) poly_shift_add:
assumes "f ∈ carrier P"
assumes "g ∈ carrier P"
shows "poly_shift (f ⊕⇘P⇙ g) = (poly_shift f) ⊕⇘P⇙ (poly_shift g)"
apply(rule ext)
using cfs_add[of "poly_shift f" "poly_shift g"] poly_shift_closed poly_shift_def
by (simp add: poly_shift_def assms(1) assms(2))
lemma(in UP_cring) poly_shift_s_mult:
assumes "f ∈ carrier P"
assumes "s ∈ carrier R"
shows "poly_shift (s ⊙⇘P⇙f) = s ⊙⇘P⇙ (poly_shift f)"
proof-
have "(s ⊙⇘P⇙f) = (ctrm (s ⊙⇘P⇙f)) ⊕⇘P⇙(X ⊗⇘P⇙ poly_shift (s ⊙⇘P⇙f))"
using poly_shift_eq[of "(s ⊙⇘P⇙f)"] assms(1) assms(2)
by blast
then have 0: "(s ⊙⇘P⇙f) = (s ⊙⇘P⇙(ctrm f)) ⊕⇘P⇙(X ⊗⇘P⇙ poly_shift (s ⊙⇘P⇙f))"
using ctrm_smult assms(1) assms(2) by auto
have 1: "(s ⊙⇘P⇙f) = s ⊙⇘P⇙ ((ctrm f) ⊕⇘P⇙ (X ⊗⇘P⇙ (poly_shift f)))"
using assms(1) poly_shift_eq by auto
have 2: "(s ⊙⇘P⇙f) = (s ⊙⇘P⇙(ctrm f)) ⊕⇘P⇙ (s ⊙⇘P⇙(X ⊗⇘P⇙ (poly_shift f)))"
by (simp add: "1" X_closed assms(1) assms(2) ctrm_is_poly poly_shift_closed smult_r_distr)
have 3: "(s ⊙⇘P⇙f) = (s ⊙⇘P⇙(ctrm f)) ⊕⇘P⇙ (X ⊗⇘P⇙ (s ⊙⇘P⇙(poly_shift f)))"
using "2" UP_m_comm X_closed assms(1) assms(2) smult_assoc2
by (simp add: poly_shift_closed)
have 4: "(X ⊗⇘P⇙ poly_shift (s ⊙⇘P⇙f)) = (X ⊗⇘P⇙ (s ⊙⇘P⇙(poly_shift f)))"
using 3 0 X_closed assms(1) assms(2) ctrm_is_poly poly_shift_closed
by auto
then show ?thesis
using X_closed X_not_zero assms(1) assms(2)
by (metis UP_mult_closed UP_smult_closed zcf_eq_zero_unique poly_shift_closed)
qed
lemma zcf_poly_shift:
assumes "f ∈ carrier P"
shows "zcf (poly_shift f) = f 1"
apply(rule poly_induct3)
apply (simp add: assms)
using poly_shift_add zcf_add cfs_add poly_shift_closed apply metis
unfolding zcf_def using poly_shift_monom poly_shift_degree_zero
by (simp add: poly_shift_def)
fun poly_shift_iter ("shift") where
Base:"poly_shift_iter 0 f = f"|
Step:"poly_shift_iter (Suc n) f = poly_shift (poly_shift_iter n f)"
lemma shift_closed:
assumes "f ∈ carrier P"
shows "shift n f ∈ carrier P"
apply(induction n)
using assms poly_shift_closed by auto
subsection‹Operator Which Multiplies Coefficients by Their Degree›
definition n_mult where
"n_mult f = (λn. [n]⋅⇘R⇙(f n))"
lemma(in UP_cring) n_mult_closed:
assumes "f ∈ carrier P"
shows "n_mult f ∈ carrier P"
apply(rule UP_car_memI[of "deg R f"])
unfolding n_mult_def
apply (metis P.l_zero R.add.nat_pow_one UP_zero_closed assms cfs_zero coeff_of_sum_diff_degree0)
using assms cfs_closed by auto
text‹Facts about the shift function›
lemma shift_one:
"shift (Suc 0) = poly_shift"
by auto
lemma shift_factor0:
assumes "f ∈ carrier P"
shows "degree f ≥ (Suc k) ⟹ degree (f ⊖⇘P⇙ ((shift (Suc k) f) ⊗⇘P⇙(X[^]⇘P⇙(Suc k)))) < (Suc k)"
proof(induction k)
case 0
have 0: " f ⊖⇘P⇙ (ctrm f) = (shift (Suc 0) f)⊗⇘P⇙X"
by (metis UP_m_comm X_closed assms poly_shift_id shift_closed shift_one)
then have " f ⊖⇘P⇙(shift (Suc 0) f)⊗⇘P⇙X = (ctrm f) "
proof-
have " f ⊖⇘P⇙ (ctrm f) ⊖⇘P⇙ (shift (Suc 0) f)⊗⇘P⇙X= (shift (Suc 0) f)⊗⇘P⇙X ⊖⇘P⇙ (shift (Suc 0) f)⊗⇘P⇙X"
using 0 by simp
then have " f ⊖⇘P⇙ (ctrm f) ⊖⇘P⇙ (shift (Suc 0) f)⊗⇘P⇙X = 𝟬⇘P⇙"
using UP_cring.UP_cring[of R] assms
by (metis "0" P.ring_simprules(4) P_def UP_ring.UP_ring UP_ring_axioms
a_minus_def abelian_group.r_neg ctrm_is_poly ring_def)
then have " f ⊖⇘P⇙ ((ctrm f) ⊕⇘P⇙ (shift (Suc 0) f)⊗⇘P⇙X) = 𝟬⇘P⇙"
using assms P.ring_simprules
by (metis "0" poly_shift_id poly_shift_eq)
then have " f ⊖⇘P⇙ ((shift (Suc 0) f)⊗⇘P⇙X ⊕⇘P⇙ (ctrm f) ) = 𝟬⇘P⇙"
using P.m_closed UP_a_comm X_closed assms ctrm_is_poly shift_closed
by presburger
then have "f ⊖⇘P⇙ ((shift (Suc 0) f)⊗⇘P⇙X) ⊖⇘P⇙ (ctrm f)= 𝟬⇘P⇙"
using P.add.m_assoc P.ring_simprules(14) P.ring_simprules(19) assms "0"
P.add.inv_closed P.r_neg P.r_zero ctrm_is_poly
by smt
then show ?thesis
by (metis "0" P.add.m_comm P.m_closed P.ring_simprules(14) P.ring_simprules(18)
P.ring_simprules(3) X_closed assms ctrm_is_poly poly_shift_id poly_shift_eq
shift_closed)
qed
then have " f ⊖⇘P⇙(shift (Suc 0) f)⊗⇘P⇙(X[^]⇘P⇙(Suc 0)) = (ctrm f) "
proof-
have "X = X[^]⇘P⇙(Suc 0)"
by (simp add: X_closed)
then show ?thesis
using 0 ‹f ⊖⇘P⇙ shift (Suc 0) f ⊗⇘P⇙ X = ctrm f›
by auto
qed
then have " degree (f ⊖⇘P⇙(shift (Suc 0) f)⊗⇘P⇙(X[^]⇘P⇙(Suc 0))) < 1"
using ctrm_degree[of f] assms by simp
then show ?case
by blast
next
case (Suc n)
fix k
assume IH: "degree f ≥ (Suc k) ⟹ degree (f ⊖⇘P⇙ ((shift (Suc k) f) ⊗⇘P⇙(X[^]⇘P⇙(Suc k)))) < (Suc k)"
show "degree f ≥ (Suc (Suc k)) ⟹ degree (f ⊖⇘P⇙ ((shift (Suc (Suc k)) f) ⊗⇘P⇙(X[^]⇘P⇙(Suc (Suc k))))) < (Suc (Suc k))"
proof-
obtain n where n_def: "n = Suc k"
by simp
have IH': "degree f ≥ n ⟹ degree (f ⊖⇘P⇙ ((shift n f) ⊗⇘P⇙(X[^]⇘P⇙n))) < n"
using n_def IH by auto
have P: "degree f ≥ (Suc n) ⟹ degree (f ⊖⇘P⇙ ((shift (Suc n) f) ⊗⇘P⇙(X[^]⇘P⇙(Suc n)))) < (Suc n)"
proof-
obtain g where g_def: "g = (f ⊖⇘P⇙ ((shift n f) ⊗⇘P⇙(X[^]⇘P⇙n)))"
by simp
obtain s where s_def: "s = shift n f"
by simp
obtain s' where s'_def: "s' = shift (Suc n) f"
by simp
have P: "g ∈ carrier P" "s ∈ carrier P" "s' ∈ carrier P" "(X[^]⇘P⇙n) ∈ carrier P"
using s_def s'_def g_def assms shift_closed[of f n]
apply (simp add: X_closed)
apply (simp add: ‹f ∈ carrier P ⟹ shift n f ∈ carrier P› assms s_def)
using P_def UP_cring.shift_closed UP_cring_axioms assms s'_def apply blast
using X_closed by blast
have g_def': "g = (f ⊖⇘P⇙ (s ⊗⇘P⇙(X[^]⇘P⇙n)))"
using g_def s_def by auto
assume "degree f ≥ (Suc n)"
then have " degree (f ⊖⇘P⇙ (s ⊗⇘P⇙(X[^]⇘P⇙n))) < n"
using IH' Suc_leD s_def by blast
then have d_g: "degree g < n" using g_def' by auto
have P0: "f ⊖⇘P⇙ (s' ⊗⇘P⇙(X[^]⇘P⇙(Suc n))) = ((ctrm s)⊗⇘P⇙(X[^]⇘P⇙n)) ⊕⇘P⇙ g"
proof-
have "s = (ctrm s) ⊕⇘P⇙ (X ⊗⇘P⇙ s')"
using s_def s'_def P_def poly_shift_eq UP_cring_axioms assms shift_closed
by (simp add: UP_cring.poly_shift_eq)
then have 0: "g = f ⊖⇘P⇙ ((ctrm s) ⊕⇘P⇙ (X ⊗⇘P⇙ s')) ⊗⇘P⇙(X[^]⇘P⇙n)"
using g_def' by auto
then have "g = f ⊖⇘P⇙ ((ctrm s)⊗⇘P⇙(X[^]⇘P⇙n)) ⊖⇘P⇙ ((X ⊗⇘P⇙ s') ⊗⇘P⇙(X[^]⇘P⇙n))"
using P cring X_closed P.l_distr P.ring_simprules(19) UP_a_assoc a_minus_def assms
by (simp add: a_minus_def ctrm_is_poly)
then have "g ⊕⇘P⇙ ((X ⊗⇘P⇙ s') ⊗⇘P⇙(X[^]⇘P⇙n)) = f ⊖⇘P⇙ ((ctrm s)⊗⇘P⇙(X[^]⇘P⇙n))"
using P cring X_closed P.l_distr P.ring_simprules UP_a_assoc a_minus_def assms
by (simp add: P.r_neg2 ctrm_is_poly)
then have " ((ctrm s)⊗⇘P⇙(X[^]⇘P⇙n)) = f ⊖⇘P⇙ (g ⊕⇘P⇙ ((X ⊗⇘P⇙ s') ⊗⇘P⇙(X[^]⇘P⇙n)))"
using P cring X_closed P.ring_simprules UP_a_assoc a_minus_def assms
by (simp add: P.ring_simprules(17) ctrm_is_poly)
then have " ((ctrm s)⊗⇘P⇙(X[^]⇘P⇙n)) = f ⊖⇘P⇙ (((X ⊗⇘P⇙ s') ⊗⇘P⇙(X[^]⇘P⇙n)) ⊕⇘P⇙ g)"
by (simp add: P(1) P(3) UP_a_comm X_closed)
then have "((ctrm s)⊗⇘P⇙(X[^]⇘P⇙n)) = f ⊖⇘P⇙ ((X ⊗⇘P⇙ s') ⊗⇘P⇙(X[^]⇘P⇙n)) ⊖⇘P⇙ g"
using P(1) P(3) P.ring_simprules(19) UP_a_assoc a_minus_def assms
by (simp add: a_minus_def X_closed)
then have "((ctrm s)⊗⇘P⇙(X[^]⇘P⇙n)) ⊕⇘P⇙ g= f ⊖⇘P⇙ ((X ⊗⇘P⇙ s') ⊗⇘P⇙(X[^]⇘P⇙n))"
by (metis P(1) P(3) P(4) P.add.inv_solve_right P.m_closed P.ring_simprules(14)
P.ring_simprules(4) P_def UP_cring.X_closed UP_cring_axioms assms)
then have "((ctrm s)⊗⇘P⇙(X[^]⇘P⇙n)) ⊕⇘P⇙ g= f ⊖⇘P⇙ ((s' ⊗⇘P⇙ X) ⊗⇘P⇙(X[^]⇘P⇙n))"
by (simp add: P(3) UP_m_comm X_closed)
then have "((ctrm s)⊗⇘P⇙(X[^]⇘P⇙n)) ⊕⇘P⇙ g= f ⊖⇘P⇙ (s' ⊗⇘P⇙(X[^]⇘P⇙(Suc n)))"
using P(3) P.nat_pow_Suc2 UP_m_assoc X_closed by auto
then show ?thesis
by auto
qed
have P1: "degree (((ctrm s)⊗⇘P⇙(X[^]⇘P⇙n)) ⊕⇘P⇙ g) ≤ n"
proof-
have Q0: "degree ((ctrm s)⊗⇘P⇙(X[^]⇘P⇙n)) ≤ n"
proof(cases "ctrm s = 𝟬⇘P⇙")
case True
then show ?thesis
by (simp add: P(4))
next
case False
then have F0: "degree ((ctrm s)⊗⇘P⇙(X[^]⇘P⇙n)) ≤ degree (ctrm s) + degree (X[^]⇘P⇙n) "
by (meson ctrm_is_poly P(2) P(4) deg_mult_ring)
have F1: "𝟭≠𝟬⟹ degree (X[^]⇘P⇙n) = n"
unfolding X_poly_def
using P_def cring_monom_degree by auto
show ?thesis
by (metis (no_types, hide_lams) F0 F1 ltrm_deg_0 P(2) P.r_null P_def R.l_null R.l_one
R.nat_pow_closed R.zero_closed X_poly_def assms cfs_closed
add_0 deg_const deg_zero deg_ltrm
monom_pow monom_zero zero_le)
qed
then show ?thesis
using d_g
by (simp add: P(1) P(2) P(4) bound_deg_sum ctrm_is_poly)
qed
then show ?thesis
using s'_def P0 by auto
qed
assume "degree f ≥ (Suc (Suc k)) "
then show "degree (f ⊖⇘P⇙ ((shift (Suc (Suc k)) f) ⊗⇘P⇙(X[^]⇘P⇙(Suc (Suc k))))) < (Suc (Suc k))"
using P by(simp add: n_def)
qed
qed
lemma(in UP_cring) shift_degree0:
assumes "f ∈ carrier P"
shows "degree f >n ⟹ Suc (degree (shift (Suc n) f)) = degree (shift n f)"
proof(induction n)
case 0
assume B: "0< degree f"
have 0: "degree (shift 0 f) = degree f"
by simp
have 1: "degree f = degree (f ⊖⇘P⇙ (ctrm f))"
using assms(1) B ctrm_degree degree_of_difference_diff_degree
by (simp add: ctrm_is_poly)
have "(f ⊖⇘P⇙ (ctrm f)) = X ⊗⇘P⇙(shift 1 f)"
using P_def poly_shift_id UP_cring_axioms assms(1) by auto
then have "degree (f ⊖⇘P⇙ (ctrm f)) = 1 + (degree (shift 1 f))"
by (metis "1" B P.r_null X_closed add.commute assms deg_nzero_nzero degree_times_X not_gr_zero shift_closed)
then have "degree (shift 0 f) = 1 + (degree (shift 1 f))"
using 0 1 by auto
then show ?case
by simp
next
case (Suc n)
fix n
assume IH: "(n < degree f ⟹ Suc (degree (shift (Suc n) f)) = degree (shift n f))"
show "Suc n < degree f ⟹ Suc (degree (shift (Suc (Suc n)) f)) = degree (shift (Suc n) f)"
proof-
assume A: " Suc n < degree f"
then have 0: "(shift (Suc n) f) = ctrm ((shift (Suc n) f)) ⊕⇘P⇙ (shift (Suc (Suc n)) f)⊗⇘P⇙X"
by (metis UP_m_comm X_closed assms local.Step poly_shift_eq shift_closed)
have N: "(shift (Suc (Suc n)) f) ≠ 𝟬⇘P⇙"
proof
assume C: "shift (Suc (Suc n)) f = 𝟬⇘P⇙"
obtain g where g_def: "g = f ⊖⇘P⇙ (shift (Suc (Suc n)) f)⊗⇘P⇙(X[^]⇘P⇙(Suc (Suc n)))"
by simp
have C0: "degree g < degree f"
using g_def assms A
by (meson Suc_leI Suc_less_SucD Suc_mono less_trans_Suc shift_factor0)
have C1: "g = f"
using C
by (simp add: P.minus_eq X_closed assms g_def)
then show False
using C0 by auto
qed
have 1: "degree (shift (Suc n) f) = degree ((shift (Suc n) f) ⊖⇘P⇙ ctrm ((shift (Suc n) f)))"
proof(cases "degree (shift (Suc n) f) = 0")
case True
then show ?thesis
using N assms poly_shift_degree_zero poly_shift_closed shift_closed by auto
next
case False
then have "degree (shift (Suc n) f) > degree (ctrm ((shift (Suc n) f)))"
proof -
have "shift (Suc n) f ∈ carrier P"
using assms shift_closed by blast
then show ?thesis
using False ctrm_degree by auto
qed
then show ?thesis
proof -
show ?thesis
using ‹degree (ctrm (shift (Suc n) f)) < degree (shift (Suc n) f)›
assms ctrm_is_poly degree_of_difference_diff_degree shift_closed by presburger
qed
qed
have 2: "(shift (Suc n) f) ⊖⇘P⇙ ctrm ((shift (Suc n) f)) = (shift (Suc (Suc n)) f)⊗⇘P⇙X"
using 0
by (metis Cring_Poly.INTEG.Step P.m_comm X_closed assms poly_shift_id shift_closed)
have 3: "degree ((shift (Suc n) f) ⊖⇘P⇙ ctrm ((shift (Suc n) f))) = degree (shift (Suc (Suc n)) f) + 1"
using 2 N X_closed X_not_zero assms degree_X shift_closed
by (metis UP_m_comm degree_times_X)
then show ?thesis using 1
by linarith
qed
qed
lemma(in UP_cring) shift_degree:
assumes "f ∈ carrier P"
shows "degree f ≥ n ⟹ degree (shift n f) + n = degree f"
proof(induction n)
case 0
then show ?case
by auto
next
case (Suc n)
fix n
assume IH: "(n ≤ degree f ⟹ degree (shift n f) + n = degree f)"
show "Suc n ≤ degree f ⟹ degree (shift (Suc n) f) + Suc n = degree f"
proof-
assume A: "Suc n ≤ degree f "
have 0: "degree (shift n f) + n = degree f"
using IH A by auto
have 1: "degree (shift n f) = Suc (degree (shift (Suc n) f))"
using A assms shift_degree0 by auto
show "degree (shift (Suc n) f) + Suc n = degree f"
using 0 1 by simp
qed
qed
lemma(in UP_cring) shift_degree':
assumes "f ∈ carrier P"
shows "degree (shift (degree f) f) = 0"
using shift_degree assms
by fastforce
lemma(in UP_cring) shift_above_degree:
assumes "f ∈ carrier P"
assumes "k > degree f"
shows "(shift k f) = 𝟬⇘P⇙"
proof-
have "⋀n. shift ((degree f)+ (Suc n)) f = 𝟬⇘P⇙"
proof-
fix n
show "shift ((degree f)+ (Suc n)) f = 𝟬⇘P⇙"
proof(induction n)
case 0
have B0:"shift (degree f) f = ctrm(shift (degree f) f) ⊕⇘P⇙ (shift (degree f + Suc 0) f)⊗⇘P⇙X"
proof -
have f1: "∀f n. f ∉ carrier P ∨ shift n f ∈ carrier P"
by (meson shift_closed)
then have "shift (degree f + Suc 0) f ∈ carrier P"
using assms(1) by blast
then show ?thesis
using f1 by (simp add: P.m_comm X_closed assms(1) poly_shift_eq)
qed
have B1:"shift (degree f) f = ctrm(shift (degree f) f)"
proof -
have "shift (degree f) f ∈ carrier P"
using assms(1) shift_closed by blast
then show ?thesis
using ltrm_deg_0 assms(1) shift_degree' by auto
qed
have B2: "(shift (degree f + Suc 0) f)⊗⇘P⇙X = 𝟬⇘P⇙"
using B0 B1 X_closed assms(1)
proof -
have "∀f n. f ∉ carrier P ∨ shift n f ∈ carrier P"
using shift_closed by blast
then show ?thesis
by (metis (no_types) B0 B1 P.add.l_cancel_one UP_mult_closed X_closed assms(1))
qed
then show ?case
by (metis P.r_null UP_m_comm UP_zero_closed X_closed assms(1) zcf_eq_zero_unique shift_closed)
next
case (Suc n)
fix n
assume "shift (degree f + Suc n) f = 𝟬⇘P⇙"
then show "shift (degree f + Suc (Suc n)) f = 𝟬⇘P⇙"
by (simp add: poly_shift_degree_zero)
qed
qed
then show ?thesis
using assms(2) less_iff_Suc_add by auto
qed
lemma(in UP_domain) shift_cfs0:
assumes "f ∈ carrier P"
shows "zcf(shift 1 f) = f 1"
using assms
by (simp add: zcf_poly_shift)
lemma(in UP_cring) X_mult_cf:
assumes "p ∈ carrier P"
shows "(p ⊗⇘P⇙ X) (k+1) = p k"
unfolding X_poly_def
using assms
by (metis UP_m_comm X_closed X_poly_def add.commute plus_1_eq_Suc cfs_times_X)
lemma(in UP_cring) X_pow_cf:
assumes "p ∈ carrier P"
shows "(p ⊗⇘P⇙ X[^]⇘P⇙(n::nat)) (n + k) = p k"
proof-
have P: "⋀f. f ∈ carrier P ⟹ (f ⊗⇘P⇙ X[^]⇘P⇙(n::nat)) (n + k) = f k"
proof(induction n)
show "⋀f. f ∈ carrier P ⟹ (f ⊗⇘P⇙ X [^]⇘P⇙ (0::nat)) (0 + k) = f k"
proof-
fix f
assume B0: "f ∈ carrier P"
show "(f ⊗⇘P⇙ X [^]⇘P⇙ (0::nat)) (0 + k) = f k"
by (simp add: B0)
qed
fix n
fix f
assume IH: "(⋀f. f ∈ carrier P ⟹ (f ⊗⇘P⇙ X [^]⇘P⇙ n) (n + k) = f k)"
assume A0: " f ∈ carrier P"
show "(f ⊗⇘P⇙ X [^]⇘P⇙ Suc n) (Suc n + k) = f k"
proof-
have 0: "(f ⊗⇘P⇙ X [^]⇘P⇙ n)(n + k) = f k"
using A0 IH by simp
have 1: "((f ⊗⇘P⇙ X [^]⇘P⇙ n)⊗⇘P⇙X) (Suc n + k) = (f ⊗⇘P⇙ X [^]⇘P⇙ n)(n + k)"
using X_mult_cf A0 P.m_closed P.nat_pow_closed
Suc_eq_plus1 X_closed add_Suc by presburger
have 2: "(f ⊗⇘P⇙ (X [^]⇘P⇙ n ⊗⇘P⇙X)) (Suc n + k) = (f ⊗⇘P⇙ X [^]⇘P⇙ n)(n + k)"
using 1
by (simp add: A0 UP_m_assoc X_closed)
then show ?thesis
by (simp add: "0")
qed
qed
show ?thesis using assms P[of p] by auto
qed
lemma poly_shift_cfs:
assumes "f ∈ carrier P"
shows "poly_shift f n = f (Suc n)"
proof-
have "(f ⊖⇘P⇙ ctrm f) (Suc n) = (X ⊗⇘P⇙ (poly_shift f)) (Suc n)"
using assms poly_shift_id by auto
then show ?thesis unfolding X_poly_def using poly_shift_closed assms
by (metis (no_types, lifting) ctrm_degree ctrm_is_poly
P.add.m_comm P.minus_closed coeff_of_sum_diff_degree0 poly_shift_id poly_shift_eq cfs_times_X zero_less_Suc)
qed
lemma(in UP_cring) shift_cfs:
assumes "p ∈ carrier P"
shows "(shift k p) n = p (k + n)"
apply(induction k arbitrary: n)
by (auto simp: assms poly_shift_cfs shift_closed)
subsection‹The Derivative Operator›
definition pderiv where
"pderiv p = poly_shift (n_mult p)"
lemma pderiv_closed:
assumes "p ∈ carrier P"
shows "pderiv p ∈ carrier P"
unfolding pderiv_def
using assms n_mult_closed[of p] poly_shift_closed[of "n_mult p"]
by blast
text‹Function which obtains the first n+1 terms of f, in ascending order of degree:›
definition trms_of_deg_leq where
"trms_of_deg_leq n f ≡ f ⊖⇘(UP R)⇙ ((shift (Suc n) f) ⊗⇘UP R⇙ monom P 𝟭 (Suc n))"
lemma trms_of_deg_leq_closed:
assumes "f ∈ carrier P"
shows "trms_of_deg_leq n f ∈ carrier P"
unfolding trms_of_deg_leq_def using assms
by (metis P.m_closed P.minus_closed P_def R.one_closed monom_closed shift_closed)
lemma trms_of_deg_leq_id:
assumes "f ∈ carrier P"
shows "f ⊖⇘P⇙ (trms_of_deg_leq k f) = shift (Suc k) f ⊗⇘P⇙ monom P 𝟭 (Suc k)"
unfolding trms_of_deg_leq_def
using assms
by (smt P.add.inv_closed P.l_zero P.m_closed P.minus_add P.minus_minus P.r_neg
P_def R.one_closed UP_a_assoc a_minus_def monom_closed shift_closed)
lemma trms_of_deg_leq_id':
assumes "f ∈ carrier P"
shows "f = (trms_of_deg_leq k f) ⊕⇘P⇙ shift (Suc k) f ⊗⇘P⇙ monom P 𝟭 (Suc k)"
using trms_of_deg_leq_id assms trms_of_deg_leq_closed[of f]
by (smt P.add.inv_closed P.l_zero P.m_closed P.minus_add P.minus_minus P.r_neg R.one_closed UP_a_assoc a_minus_def monom_closed shift_closed)
lemma deg_leqI:
assumes "p ∈ carrier P"
assumes "⋀n. n > k ⟹ p n = 𝟬"
shows "degree p ≤ k"
by (metis assms(1) assms(2) deg_zero deg_ltrm le0 le_less_linear monom_zero)
lemma deg_leE:
assumes "p ∈ carrier P"
assumes "degree p < k"
shows "p k = 𝟬"
using assms coeff_of_sum_diff_degree0 P_def coeff_simp deg_aboveD
by auto
lemma trms_of_deg_leq_deg:
assumes "f ∈ carrier P"
shows "degree (trms_of_deg_leq k f) ≤ k"
proof-
have "⋀n. (trms_of_deg_leq k f) (Suc k + n) = 𝟬"
proof-
fix n
have 0: "(shift (Suc k) f ⊗⇘UP R⇙ monom P 𝟭 (Suc k)) (Suc k + n) = shift (Suc k) f n"
using assms shift_closed cfs_monom_mult_l
by (metis P.m_comm P_def R.one_closed add.commute monom_closed times_X_pow_coeff)
then show "trms_of_deg_leq k f (Suc k + n) = 𝟬"
unfolding trms_of_deg_leq_def
using shift_cfs[of f "Suc k" n]
cfs_minus[of f "shift (Suc k) f ⊗⇘UP R⇙ monom P 𝟭 (Suc k)" "Suc k + n"]
by (metis P.m_closed P.r_neg P_def R.one_closed a_minus_def assms
cfs_minus cfs_zero monom_closed shift_closed)
qed
then show ?thesis using deg_leqI
by (metis (no_types, lifting) assms le_iff_add less_Suc_eq_0_disj less_Suc_eq_le trms_of_deg_leq_closed)
qed
lemma trms_of_deg_leq_zero_is_ctrm:
assumes "f ∈ carrier P"
assumes "degree f > 0"
shows "trms_of_deg_leq 0 f = ctrm f"
proof-
have "f = ctrm f ⊕⇘P⇙ (X ⊗⇘P⇙ (shift (Suc 0) f))"
using assms poly_shift_eq
by simp
then have "f = ctrm f ⊕⇘P⇙ (X [^]⇘UP R⇙ Suc 0 ⊗⇘P⇙ (shift (Suc 0) f))"
using P.nat_pow_eone P_def X_closed by auto
then show ?thesis
unfolding trms_of_deg_leq_def
by (metis (no_types, lifting) ctrm_is_poly One_nat_def P.add.right_cancel P.m_closed
P.minus_closed P.nat_pow_eone P_def UP_m_comm X_closed X_poly_def assms(1) shift_closed
trms_of_deg_leq_def trms_of_deg_leq_id')
qed
lemma cfs_monom_mult:
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
assumes "k < n"
shows "(p ⊗⇘P⇙ (monom P a n)) k = 𝟬"
apply(rule poly_induct3[of p])
apply (simp add: assms(1))
apply (metis (no_types, lifting) P.l_distr P.m_closed R.r_zero R.zero_closed assms(2) cfs_add monom_closed)
using assms monom_mult[of _ a _ n]
by (metis R.m_closed R.m_comm add.commute cfs_monom not_add_less1)
lemma(in UP_cring) cfs_monom_mult_2:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
assumes "m < n"
shows "((monom P a n) ⊗⇘P⇙ f) m = 𝟬"
using cfs_monom_mult
by (simp add: P.m_comm assms(1) assms(2) assms(3))
lemma trms_of_deg_leq_cfs:
assumes "f ∈ carrier P"
shows "trms_of_deg_leq n f k = (if k ≤ n then (f k) else 𝟬)"
unfolding trms_of_deg_leq_def
apply(cases "k ≤ n")
using cfs_minus[of f "shift (Suc n) f ⊗⇘UP R⇙ monom P 𝟭 (Suc n)"]
cfs_monom_mult[of _ 𝟭 k "Suc n"]
apply (metis (no_types, lifting) P.m_closed P.minus_closed P_def R.one_closed R.r_zero assms
cfs_add cfs_closed le_refl monom_closed nat_less_le nat_neq_iff not_less_eq_eq shift_closed
trms_of_deg_leq_def trms_of_deg_leq_id')
using trms_of_deg_leq_deg[of f n] deg_leE
unfolding trms_of_deg_leq_def
using assms trms_of_deg_leq_closed trms_of_deg_leq_def by auto
lemma trms_of_deg_leq_iter:
assumes "f ∈ carrier P"
shows "trms_of_deg_leq (Suc k) f = (trms_of_deg_leq k f) ⊕⇘P⇙ monom P (f (Suc k)) (Suc k)"
proof fix x
show "trms_of_deg_leq (Suc k) f x = (trms_of_deg_leq k f ⊕⇘P⇙ monom P (f (Suc k)) (Suc k)) x"
apply(cases "x ≤ k")
using trms_of_deg_leq_cfs trms_of_deg_leq_closed cfs_closed[of f "Suc k"]
cfs_add[of "trms_of_deg_leq k f" "monom P (f (Suc k)) (Suc k)" x]
apply (simp add: assms)
using deg_leE assms cfs_closed cfs_monom apply auto[1]
by (simp add: assms cfs_closed cfs_monom trms_of_deg_leq_cfs trms_of_deg_leq_closed)
qed
lemma trms_of_deg_leq_0:
assumes "f ∈ carrier P"
shows "trms_of_deg_leq 0 f = ctrm f"
by (metis One_nat_def P.r_null P_def UP_m_comm UP_zero_closed X_closed X_poly_def assms not_gr_zero
poly_shift_degree_zero shift_one trms_of_deg_leq_def trms_of_deg_leq_zero_is_ctrm trunc_simps(2) trunc_zero)
lemma trms_of_deg_leq_degree_f:
assumes "f ∈ carrier P"
shows "trms_of_deg_leq (degree f) f = f"
proof fix x
show "trms_of_deg_leq (deg R f) f x = f x"
using assms trms_of_deg_leq_cfs deg_leE[of f x]
by simp
qed
definition(in UP_cring) lin_part where
"lin_part f = trms_of_deg_leq 1 f"
lemma(in UP_cring) lin_part_id:
assumes "f ∈ carrier P"
shows "lin_part f = (ctrm f) ⊕⇘P⇙ monom P (f 1) 1"
unfolding lin_part_def
by (simp add: assms trms_of_deg_leq_0 trms_of_deg_leq_iter)
lemma(in UP_cring) lin_part_eq:
assumes "f ∈ carrier P"
shows "f = lin_part f ⊕⇘P⇙ (shift 2 f) ⊗⇘P⇙ monom P 𝟭 2"
unfolding lin_part_def
by (metis Suc_1 assms trms_of_deg_leq_id')
text‹Constant term of a substitution:›
lemma zcf_eval:
assumes "f ∈ carrier P"
shows "zcf f = to_fun f 𝟬"
using assms zcf_to_fun by blast
lemma ctrm_of_sub:
assumes "f ∈ carrier P"
assumes "g ∈ carrier P"
shows "zcf(f of g) = to_fun f (zcf g)"
apply(rule poly_induct3[of f])
apply (simp add: assms(1))
using P_def UP_cring.to_fun_closed UP_cring_axioms zcf_add zcf_to_fun assms(2) to_fun_plus sub_add sub_closed apply fastforce
using R.zero_closed zcf_to_fun assms(2) to_fun_sub monom_closed sub_closed by presburger
text‹Evaluation of linear part:›
lemma to_fun_lin_part:
assumes "f ∈ carrier P"
assumes "b ∈ carrier R"
shows "to_fun (lin_part f) b = (f 0) ⊕ (f 1) ⊗ b"
using assms lin_part_id[of f] to_fun_ctrm to_fun_monom monom_closed
by (simp add: cfs_closed to_fun_plus)
text‹Constant term of taylor expansion:›
lemma taylor_zcf:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "zcf(T⇘a⇙ f) = to_fun f a"
unfolding taylor_expansion_def
using ctrm_of_sub assms P_def zcf_eval X_plus_closed taylor_closed taylor_eval by auto
lemma(in UP_cring) taylor_eq_1:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "(T⇘a⇙ f) ⊖⇘P⇙ (trms_of_deg_leq 1 (T⇘a⇙ f)) = (shift (2::nat) (T⇘a⇙ f))⊗⇘P⇙ (X[^]⇘P⇙(2::nat))"
by (metis P.nat_pow_eone P.nat_pow_mult P_def Suc_1 taylor_closed X_closed X_poly_def assms(1)
assms(2) monom_one_Suc2 one_add_one trms_of_deg_leq_id)
lemma(in UP_cring) taylor_deg_1:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "f of (X_plus a) = (lin_part (T⇘a⇙ f)) ⊕⇘P⇙ (shift (2::nat) (T⇘a⇙ f))⊗⇘P⇙ (X[^]⇘P⇙(2::nat))"
using taylor_eq_1[of f a]
unfolding taylor_expansion_def lin_part_def
using One_nat_def X_plus_closed assms(1)
assms(2) trms_of_deg_leq_id' numeral_2_eq_2 sub_closed
by (metis P.nat_pow_Suc2 P.nat_pow_eone P_def taylor_def X_closed X_poly_def monom_one_Suc taylor_expansion_def)
lemma(in UP_cring) taylor_deg_1_eval:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
assumes "c = to_fun (shift (2::nat) (T⇘a⇙ f)) b"
assumes "fa = to_fun f a"
assumes "f'a = deriv f a"
shows "to_fun f (b ⊕ a) = fa ⊕ (f'a ⊗ b) ⊕ (c ⊗ b[^](2::nat))"
using assms taylor_deg_1 unfolding derivative_def
proof-
have 0: "to_fun f (b ⊕ a) = to_fun (f of (X_plus a)) b"
using to_fun_sub assms X_plus_closed by auto
have 1: "to_fun (lin_part (T⇘a⇙ f)) b = fa ⊕ (f'a ⊗ b) "
using assms to_fun_lin_part[of "(T⇘a⇙ f)" b]
by (metis P_def taylor_def UP_cring.taylor_zcf UP_cring.taylor_closed UP_cring_axioms zcf_def derivative_def)
have 2: "(T⇘a⇙ f) = (lin_part (T⇘a⇙ f)) ⊕⇘P⇙ ((shift 2 (T⇘a⇙ f))⊗⇘P⇙X[^]⇘P⇙(2::nat))"
using lin_part_eq[of "(T⇘a⇙f)"] assms(1) assms(2) taylor_closed
by (metis taylor_def taylor_deg_1 taylor_expansion_def)
then have "to_fun (T⇘a⇙f) b = fa ⊕ (f'a ⊗ b) ⊕ to_fun ((shift 2 (T⇘a⇙ f))⊗⇘P⇙X[^]⇘P⇙(2::nat)) b"
using 1 2
by (metis P.nat_pow_closed taylor_closed UP_mult_closed X_closed assms(1) assms(2) assms(3)
to_fun_plus lin_part_def shift_closed trms_of_deg_leq_closed)
then have "to_fun (T⇘a⇙f) b = fa ⊕ (f'a ⊗ b) ⊕ c ⊗ to_fun (X[^]⇘P⇙(2::nat)) b"
by (simp add: taylor_closed X_closed assms(1) assms(2) assms(3) assms(4) to_fun_mult shift_closed)
then have 3: "to_fun f (b ⊕ a)= fa ⊕ (f'a ⊗ b) ⊕ c ⊗ to_fun (X[^]⇘P⇙(2::nat)) b"
using taylor_eval assms(1) assms(2) assms(3) by auto
have "to_fun (X[^]⇘P⇙(2::nat)) b = b[^](2::nat)"
by (metis P.nat_pow_Suc2 P.nat_pow_eone R.nat_pow_Suc2
R.nat_pow_eone Suc_1 to_fun_X
X_closed assms(3) to_fun_mult)
then show ?thesis
using 3 by auto
qed
lemma(in UP_cring) taylor_deg_1_eval':
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
assumes "c = to_fun (shift (2::nat) (T⇘a⇙ f)) b"
assumes "fa = to_fun f a"
assumes "f'a = deriv f a"
shows "to_fun f (a ⊕ b) = fa ⊕ (f'a ⊗ b) ⊕ (c ⊗ b[^](2::nat))"
using R.add.m_comm taylor_deg_1_eval assms(1) assms(2) assms(3) assms(4) assms(5) assms(6)
by auto
lemma(in UP_cring) taylor_deg_1_eval'':
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
assumes "c = to_fun (shift (2::nat) (T⇘a⇙ f)) (⊖b)"
shows "to_fun f (a ⊖ b) = (to_fun f a) ⊖ (deriv f a ⊗ b) ⊕ (c ⊗ b[^](2::nat))"
proof-
have "⊖b ∈ carrier R"
using assms
by blast
then have 0: "to_fun f (a ⊖ b) = (to_fun f a)⊕ (deriv f a ⊗ (⊖b)) ⊕ (c ⊗ (⊖b)[^](2::nat))"
unfolding a_minus_def
using taylor_deg_1_eval'[of f a "⊖b" c "(to_fun f a)" "deriv f a"] assms
by auto
have 1: "⊖ (deriv f a ⊗ b) = (deriv f a ⊗ (⊖b))"
using assms
by (simp add: R.r_minus deriv_closed)
have 2: "(c ⊗ b[^](2::nat)) = (c ⊗ (⊖b)[^](2::nat))"
using assms
by (metis R.add.inv_closed R.add.inv_solve_right R.l_zero R.nat_pow_Suc2
R.nat_pow_eone R.zero_closed Suc_1 UP_ring_axioms UP_ring_def
ring.ring_simprules(26) ring.ring_simprules(27))
show ?thesis
using 0 1 2
unfolding a_minus_def
by simp
qed
lemma(in UP_cring) taylor_deg_1_expansion:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
assumes "c = to_fun (shift (2::nat) (T⇘a⇙ f)) (b ⊖ a)"
assumes "fa = to_fun f a"
assumes "f'a = deriv f a"
shows "to_fun f (b) = fa ⊕ f'a ⊗ (b ⊖ a) ⊕ (c ⊗ (b ⊖ a)[^](2::nat))"
proof-
obtain b' where b'_def: "b'= b ⊖ a "
by simp
then have b'_def': "b = b' ⊕ a"
using assms
by (metis R.add.inv_solve_right R.minus_closed R.minus_eq)
have "to_fun f (b' ⊕ a) = fa ⊕ (f'a ⊗ b') ⊕ (c ⊗ b'[^](2::nat))"
using assms taylor_deg_1_eval[of f a b' c fa f'a] b'_def
by blast
then have "to_fun f (b) = fa ⊕ (f'a ⊗ b') ⊕ (c ⊗ b'[^](2::nat))"
using b'_def'
by auto
then show "to_fun f (b) = fa ⊕ f'a ⊗ (b ⊖ a) ⊕ c ⊗ (b ⊖ a) [^] (2::nat)"
using b'_def
by auto
qed
lemma(in UP_cring) Taylor_deg_1_expansion':
assumes "f ∈ carrier (UP R)"
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "∃c ∈ carrier R. to_fun f (b) = (to_fun f a) ⊕ (deriv f a) ⊗ (b ⊖ a) ⊕ (c ⊗ (b ⊖ a)[^](2::nat))"
using taylor_deg_1_expansion[of f a b] assms unfolding P_def
by (metis P_def R.minus_closed taylor_closed shift_closed to_fun_closed)
text‹Basic Properties of deriv and pderiv:›
lemma n_mult_degree_bound:
assumes "f ∈ carrier P"
shows "degree (n_mult f) ≤ degree f"
apply(rule deg_leqI)
apply (simp add: assms n_mult_closed)
by (simp add: assms deg_leE n_mult_def)
lemma pderiv_deg_0[simp]:
assumes "f ∈ carrier P"
assumes "degree f = 0"
shows "pderiv f = 𝟬⇘P⇙"
proof-
have "degree (n_mult f) = 0"
using P_def n_mult_degree_bound assms(1) assms(2) by fastforce
then show ?thesis
unfolding pderiv_def
by (simp add: assms(1) n_mult_closed poly_shift_degree_zero)
qed
lemma deriv_deg_0:
assumes "f ∈ carrier P"
assumes "degree f = 0"
assumes "a ∈ carrier R"
shows "deriv f a = 𝟬"
unfolding derivative_def taylor_expansion_def
using X_plus_closed assms(1) assms(2) assms(3) deg_leE sub_const by force
lemma poly_shift_monom':
assumes "a ∈ carrier R"
shows "poly_shift (a ⊙⇘P⇙ (X[^]⇘P⇙(Suc n))) = a⊙⇘P⇙(X[^]⇘P⇙n)"
using assms monom_rep_X_pow poly_shift_monom by auto
lemma monom_coeff:
assumes "a ∈ carrier R"
shows "(a ⊙⇘P⇙ X [^]⇘P⇙ (n::nat)) k = (if (k = n) then a else 𝟬)"
using assms cfs_monom monom_rep_X_pow by auto
lemma cfs_n_mult:
assumes "p ∈ carrier P"
shows "n_mult p n = [n]⋅(p n)"
by (simp add: n_mult_def)
lemma cfs_add_nat_pow:
assumes "p ∈ carrier P"
shows "([(n::nat)]⋅⇘P⇙p) k = [n]⋅(p k)"
apply(induction n) by (auto simp: assms)
lemma cfs_add_int_pow:
assumes "p ∈ carrier P"
shows "([(n::int)]⋅⇘P⇙p) k = [n]⋅(p k)"
apply(induction n)
by(auto simp: add_pow_int_ge assms cfs_add_nat_pow add_pow_int_lt)
lemma add_nat_pow_monom:
assumes "a ∈ carrier R"
shows "[(n::nat)]⋅⇘P⇙monom P a k = monom P ([n]⋅a) k"
apply(rule ext)
by (simp add: assms cfs_add_nat_pow cfs_monom)
lemma add_int_pow_monom:
assumes "a ∈ carrier R"
shows "[(n::int)]⋅⇘P⇙monom P a k = monom P ([n]⋅a) k"
apply(rule ext)
by (simp add: assms cfs_add_int_pow cfs_monom)
lemma n_mult_monom:
assumes "a ∈ carrier R"
shows "n_mult (monom P a (Suc n)) = monom P ([Suc n]⋅a) (Suc n)"
apply(rule ext)
unfolding n_mult_def
using assms cfs_monom by auto
lemma pderiv_monom:
assumes "a ∈ carrier R"
shows "pderiv (monom P a n) = monom P ([n]⋅a) (n-1)"
apply(cases "n = 0")
apply (simp add: assms)
unfolding pderiv_def
using assms Suc_diff_1[of n] n_mult_monom[of a "n-1"] poly_shift_monom[of "[Suc (n-1)]⋅a" "Suc (n-1)"]
by (metis R.add.nat_pow_closed neq0_conv poly_shift_monom)
lemma pderiv_monom':
assumes "a ∈ carrier R"
shows "pderiv (a ⊙⇘P⇙ X[^]⇘P⇙(n::nat)) = ([n]⋅a)⊙⇘P⇙ X[^]⇘P⇙(n-1)"
using assms pderiv_monom[of a n ]
by (simp add: P_def UP_cring.monom_rep_X_pow UP_cring_axioms)
lemma n_mult_add:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
shows "n_mult (p ⊕⇘P⇙ q) = n_mult p ⊕⇘P⇙ n_mult q"
proof(rule ext) fix x show "n_mult (p ⊕⇘P⇙ q) x = (n_mult p ⊕⇘P⇙ n_mult q) x"
using assms R.add.nat_pow_distrib[of "p x" "q x" x] cfs_add[of p q x]
cfs_add[of "n_mult p" "n_mult q" x] n_mult_closed
unfolding n_mult_def
by (simp add: cfs_closed)
qed
lemma pderiv_add:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
shows "pderiv (p ⊕⇘P⇙ q) = pderiv p ⊕⇘P⇙ pderiv q"
unfolding pderiv_def
using assms poly_shift_add n_mult_add
by (simp add: n_mult_closed)
lemma zcf_monom_sub:
assumes "p ∈ carrier P"
shows "zcf ((monom P 𝟭 (Suc n)) of p) = zcf p [^] (Suc n)"
apply(induction n)
using One_nat_def P.nat_pow_eone R.nat_pow_eone R.one_closed R.zero_closed zcf_to_fun assms to_fun_closed monom_sub smult_one apply presburger
using P_def UP_cring.ctrm_of_sub UP_cring_axioms zcf_to_fun assms to_fun_closed to_fun_monom monom_closed
by fastforce
lemma zcf_monom_sub':
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
shows "zcf ((monom P a (Suc n)) of p) = a ⊗ zcf p [^] (Suc n)"
using zcf_monom_sub assms P_def R.zero_closed UP_cring.ctrm_of_sub UP_cring.to_fun_monom UP_cring_axioms
zcf_to_fun to_fun_closed monom_closed by fastforce
lemma deriv_monom:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "deriv (monom P a n) b = ([n]⋅a)⊗(b[^](n-1))"
proof(induction n)
case 0
have 0: "b [^] ((0::nat) - 1) ∈ carrier R"
using assms
by simp
then show ?case unfolding derivative_def using assms
by (smt One_nat_def P_def R.add.nat_pow_0 R.nat_pow_Suc2 R.nat_pow_eone R.zero_closed
taylor_def taylor_deg UP_cring.taylor_closed UP_cring.zcf_monom UP_cring.shift_one
UP_cring_axioms zcf_degree_zero zcf_zero_degree_zero degree_monom monom_closed
monom_rep_X_pow plus_1_eq_Suc poly_shift_degree_zero shift_cfs to_fun_monom to_fun_zero zero_diff)
next
case (Suc n)
show ?case
proof(cases "n = 0")
case True
have T0: "[Suc n] ⋅ a ⊗ b [^] (Suc n - 1) = a"
by (simp add: True assms(1))
have T1: "(X_poly R ⊕⇘UP R⇙ to_polynomial R b) [^]⇘UP R⇙ Suc n = X_poly R ⊕⇘UP R⇙ to_polynomial R b "
using P.nat_pow_eone P_def True UP_a_closed X_closed assms(2) to_poly_closed by auto
then show ?thesis
unfolding derivative_def taylor_expansion_def
using T0 T1 True sub_monom(2)[of "X_plus b" a "Suc n"] cfs_add assms
unfolding P_def X_poly_plus_def to_polynomial_def X_poly_def
by (smt Group.nat_pow_0 lcf_eq lcf_monom(2) ltrm_of_X_plus One_nat_def P_def R.one_closed
R.r_one R.r_zero UP_cring.zcf_monom UP_cring.degree_of_X_plus
UP_cring.poly_shift_degree_zero UP_cring_axioms X_closed X_plus_closed X_poly_def
X_poly_plus_def zcf_zero_degree_zero cfs_monom_mult_l degree_to_poly to_fun_X_pow
plus_1_eq_Suc poly_shift_cfs poly_shift_monom to_poly_closed to_poly_mult_simp(2)
to_poly_nat_pow to_polynomial_def)
next
case False
have "deriv (monom P a (Suc n)) b = ((monom P a (Suc n)) of (X_plus b)) 1"
unfolding derivative_def taylor_expansion_def
by auto
then have "deriv (monom P a (Suc n)) b = (((monom P a n) of (X_plus b)) ⊗⇘P⇙ (X_plus b)) 1"
using monom_mult[of a 𝟭 n 1] sub_mult[of "X_plus b" "monom P a n" "monom P 𝟭 1" ] X_plus_closed[of b] assms
by (metis lcf_monom(1) P.l_one P.nat_pow_eone P_def R.one_closed R.r_one Suc_eq_plus1
deg_one monom_closed monom_one sub_monom(1) to_poly_inverse)
then have "deriv (monom P a (Suc n)) b = (((monom P a n) of (X_plus b)) ⊗⇘P⇙ (monom P 𝟭 1) ⊕⇘P⇙
(((monom P a n) of (X_plus b)) ⊗⇘P⇙ to_poly b)) 1"
unfolding X_poly_plus_def
by (metis P.r_distr P_def X_closed X_plus_closed X_poly_def X_poly_plus_def assms(1) assms(2) monom_closed sub_closed to_poly_closed)
then have "deriv (monom P a (Suc n)) b = ((monom P a n) of (X_plus b)) 0 ⊕ b ⊗ ((monom P a n) of (X_plus b)) 1"
unfolding X_poly_plus_def
by (smt One_nat_def P.m_closed P_def UP_m_comm X_closed X_plus_closed X_poly_def X_poly_plus_def
assms(1) assms(2) cfs_add cfs_monom_mult_l monom_closed plus_1_eq_Suc sub_closed cfs_times_X to_polynomial_def)
then have "deriv (monom P a (Suc n)) b = ((monom P a n) of (X_plus b)) 0 ⊕ b ⊗ (deriv (monom P a n) b)"
by (simp add: derivative_def taylor_expansion_def)
then have "deriv (monom P a (Suc n)) b = ((monom P a n) of (X_plus b)) 0 ⊕ b ⊗ ( ([n]⋅a)⊗(b[^](n-1)))"
by (simp add: Suc)
then have 0: "deriv (monom P a (Suc n)) b = ((monom P a n) of (X_plus b)) 0 ⊕ ([n]⋅a)⊗(b[^]n)"
using assms R.m_comm[of b] R.nat_pow_mult[of b "n-1" 1] False
by (metis (no_types, lifting) R.add.nat_pow_closed R.m_lcomm R.nat_pow_closed R.nat_pow_eone add.commute add_eq_if plus_1_eq_Suc)
have 1: "((monom P a n) of (X_plus b)) 0 = a ⊗ b[^]n"
unfolding X_poly_plus_def using zcf_monom_sub'
by (smt ctrm_of_sub One_nat_def P_def R.l_zero R.one_closed UP_cring.zcf_to_poly
UP_cring.f_minus_ctrm UP_cring_axioms X_plus_closed X_poly_def X_poly_plus_def zcf_add
zcf_def assms(1) assms(2) to_fun_monom monom_closed monom_one_Suc2 poly_shift_id poly_shift_monom to_poly_closed)
show ?thesis
using 0 1 R.add.nat_pow_Suc2 R.add.nat_pow_closed R.l_distr R.nat_pow_closed assms(1) assms(2) diff_Suc_1 by presburger
qed
qed
lemma deriv_smult:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
assumes "g ∈ carrier P"
shows "deriv (a ⊙⇘P⇙ g) b = a ⊗ (deriv g b)"
unfolding derivative_def taylor_expansion_def
using assms sub_smult X_plus_closed cfs_smult
by (simp add: sub_closed)
lemma deriv_const:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "deriv (monom P a 0) b = 𝟬"
unfolding derivative_def
using assms taylor_closed taylor_def taylor_deg deg_leE by auto
lemma deriv_monom_deg_one:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "deriv (monom P a 1) b = a"
unfolding derivative_def taylor_expansion_def
using assms cfs_X_plus[of b 1] sub_monom_deg_one X_plus_closed[of b]
by simp
lemma monom_Suc:
assumes "a ∈ carrier R"
shows "monom P a (Suc n) = monom P 𝟭 1 ⊗⇘P⇙ monom P a n"
"monom P a (Suc n) = monom P a n ⊗⇘P⇙ monom P 𝟭 1"
apply (metis R.l_one R.one_closed Suc_eq_plus1_left assms monom_mult)
by (metis R.one_closed R.r_one Suc_eq_plus1 assms monom_mult)
subsection‹The Product Rule›
lemma(in UP_cring) times_x_product_rule:
assumes "f ∈ carrier P"
shows "pderiv (f ⊗⇘P⇙ up_ring.monom P 𝟭 1) = f ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P 𝟭 1"
proof(rule poly_induct3[of f])
show "f ∈ carrier P"
using assms by blast
show "⋀p q. q ∈ carrier P ⟹
p ∈ carrier P ⟹
pderiv (p ⊗⇘P⇙ up_ring.monom P 𝟭 1) = p ⊕⇘P⇙ pderiv p ⊗⇘P⇙ up_ring.monom P 𝟭 1 ⟹
pderiv (q ⊗⇘P⇙ up_ring.monom P 𝟭 1) = q ⊕⇘P⇙ pderiv q ⊗⇘P⇙ up_ring.monom P 𝟭 1 ⟹
pderiv ((p ⊕⇘P⇙ q) ⊗⇘P⇙ up_ring.monom P 𝟭 1) = p ⊕⇘P⇙ q ⊕⇘P⇙ pderiv (p ⊕⇘P⇙ q) ⊗⇘P⇙ up_ring.monom P 𝟭 1"
proof- fix p q assume A: "q ∈ carrier P"
"p ∈ carrier P"
"pderiv (p ⊗⇘P⇙ up_ring.monom P 𝟭 1) = p ⊕⇘P⇙ pderiv p ⊗⇘P⇙ up_ring.monom P 𝟭 1"
"pderiv (q ⊗⇘P⇙ up_ring.monom P 𝟭 1) = q ⊕⇘P⇙ pderiv q ⊗⇘P⇙ up_ring.monom P 𝟭 1"
have 0: "(p ⊕⇘P⇙ q) ⊗⇘P⇙ up_ring.monom P 𝟭 1 = (p ⊗⇘P⇙ up_ring.monom P 𝟭 1) ⊕⇘P⇙ (q ⊗⇘P⇙ up_ring.monom P 𝟭 1)"
using A assms by (meson R.one_closed UP_l_distr is_UP_monomE(1) is_UP_monomI)
have 1: "pderiv ((p ⊕⇘P⇙ q) ⊗⇘P⇙ up_ring.monom P 𝟭 1) = pderiv (p ⊗⇘P⇙ up_ring.monom P 𝟭 1) ⊕⇘P⇙ pderiv (q ⊗⇘P⇙ up_ring.monom P 𝟭 1)"
unfolding 0 apply(rule pderiv_add)
using A is_UP_monomE(1) monom_is_UP_monom(1) apply blast
using A is_UP_monomE(1) monom_is_UP_monom(1) by blast
have 2: "pderiv ((p ⊕⇘P⇙ q) ⊗⇘P⇙ up_ring.monom P 𝟭 1) = p ⊕⇘P⇙ pderiv p ⊗⇘P⇙ up_ring.monom P 𝟭 1 ⊕⇘P⇙ (q ⊕⇘P⇙ pderiv q ⊗⇘P⇙ up_ring.monom P 𝟭 1)"
unfolding 1 A by blast
have 3: "pderiv ((p ⊕⇘P⇙ q) ⊗⇘P⇙ up_ring.monom P 𝟭 1) = p ⊕⇘P⇙ q ⊕⇘P⇙ (pderiv p ⊗⇘P⇙ up_ring.monom P 𝟭 1 ⊕⇘P⇙ pderiv q ⊗⇘P⇙ up_ring.monom P 𝟭 1)"
unfolding 2
using A P.add.m_lcomm R.one_closed UP_a_assoc UP_a_closed UP_mult_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_closed by presburger
have 4: "pderiv ((p ⊕⇘P⇙ q) ⊗⇘P⇙ up_ring.monom P 𝟭 1) = p ⊕⇘P⇙ q ⊕⇘P⇙ ((pderiv p ⊕⇘P⇙ pderiv q) ⊗⇘P⇙ up_ring.monom P 𝟭 1)"
unfolding 3 using A P.l_distr R.one_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_closed by presburger
show 5: "pderiv ((p ⊕⇘P⇙ q) ⊗⇘P⇙ up_ring.monom P 𝟭 1) = p ⊕⇘P⇙ q ⊕⇘P⇙ pderiv (p ⊕⇘P⇙ q) ⊗⇘P⇙ up_ring.monom P 𝟭 1"
unfolding 4 using pderiv_add A by presburger
qed
show "⋀a n. a ∈ carrier R ⟹
pderiv (up_ring.monom P a n ⊗⇘P⇙ up_ring.monom P 𝟭 1) = up_ring.monom P a n ⊕⇘P⇙ pderiv (up_ring.monom P a n) ⊗⇘P⇙ up_ring.monom P 𝟭 1"
proof- fix a n assume A: "a ∈ carrier R"
have 0: "up_ring.monom P a n ⊗⇘P⇙ up_ring.monom P 𝟭 1 = up_ring.monom P a (Suc n)"
using A monom_Suc(2) by presburger
have 1: "pderiv (up_ring.monom P a n ⊗⇘P⇙ up_ring.monom P 𝟭 1) = [(Suc n)] ⋅⇘P⇙ (up_ring.monom P a n)"
unfolding 0 using A add_nat_pow_monom n_mult_monom pderiv_def poly_shift_monom
by (simp add: P_def)
have 2: "pderiv (up_ring.monom P a n ⊗⇘P⇙ up_ring.monom P 𝟭 1) = (up_ring.monom P a n) ⊕⇘P⇙ [n] ⋅⇘P⇙ (up_ring.monom P a n)"
unfolding 1 using A P.add.nat_pow_Suc2 is_UP_monomE(1) monom_is_UP_monom(1) by blast
have 3: "pderiv (up_ring.monom P a n) ⊗⇘P⇙ up_ring.monom P 𝟭 1 = [n] ⋅⇘P⇙ (up_ring.monom P a n)"
apply(cases "n = 0")
using A add_nat_pow_monom n_mult_monom pderiv_def poly_shift_monom pderiv_deg_0 apply auto[1]
using monom_Suc(2)[of a "n-1"] A add_nat_pow_monom n_mult_monom pderiv_def poly_shift_monom
by (metis R.add.nat_pow_closed Suc_eq_plus1 add_eq_if monom_Suc(2) pderiv_monom)
show "pderiv (up_ring.monom P a n ⊗⇘P⇙ up_ring.monom P 𝟭 1) = up_ring.monom P a n ⊕⇘P⇙ pderiv (up_ring.monom P a n) ⊗⇘P⇙ up_ring.monom P 𝟭 1"
unfolding 2 3 by blast
qed
qed
lemma(in UP_cring) deg_one_eval:
assumes "g ∈ carrier (UP R)"
assumes "deg R g = 1"
shows "⋀t. t ∈ carrier R ⟹ to_fun g t = g 0 ⊕ (g 1)⊗t"
proof-
obtain h where h_def: "h = ltrm g"
by blast
have 0: "deg R (g ⊖⇘UP R⇙ h) = 0"
using assms unfolding h_def
by (metis ltrm_closed ltrm_eq_imp_deg_drop ltrm_monom P_def UP_car_memE(1) less_one)
have 1: "g ⊖⇘UP R⇙ h = to_poly (g 0)"
proof(rule ext) fix x show "(g ⊖⇘UP R⇙ h) x = to_polynomial R (g 0) x"
proof(cases "x = 0")
case True
have T0: "h 0 = 𝟬"
unfolding h_def using assms UP_car_memE(1) cfs_monom by presburger
have T1: "(g ⊖⇘UP R⇙ h) 0 = g 0 ⊖ h 0"
using ltrm_closed P_def assms(1) cfs_minus h_def by blast
then show ?thesis using T0 assms
by (smt "0" ltrm_closed ltrm_deg_0 P.minus_closed P_def UP_car_memE(1) UP_zero_closed zcf_def zcf_zero deg_zero degree_to_poly h_def to_poly_closed to_poly_inverse to_poly_minus trunc_simps(2) trunc_zero)
next
case False
then have "x > 0"
by presburger
then show ?thesis
by (metis "0" ltrm_closed P.minus_closed P_def UP_car_memE(1) UP_cring.degree_to_poly UP_cring_axioms assms(1) deg_leE h_def to_poly_closed)
qed
qed
have 2: "g = (g ⊖⇘UP R⇙ h) ⊕⇘UP R⇙ h"
unfolding h_def using assms
by (metis "1" P_def h_def lin_part_def lin_part_id to_polynomial_def trms_of_deg_leq_degree_f)
fix t assume A: "t ∈ carrier R"
have 3: " to_fun g t = to_fun (g ⊖⇘UP R⇙ h) t ⊕ to_fun h t"
using 2
by (metis "1" A P_def UP_car_memE(1) assms(1) h_def monom_closed to_fun_plus to_polynomial_def)
then show "to_fun g t = g 0 ⊕ g 1 ⊗ t "
unfolding 1 h_def
using A P_def UP_cring.lin_part_def UP_cring_axioms assms(1) assms(2) to_fun_lin_part trms_of_deg_leq_degree_f by fastforce
qed
lemma nmult_smult:
assumes "a ∈ carrier R"
assumes "f ∈ carrier P"
shows "n_mult (a ⊙⇘P⇙ f) = a ⊙⇘P⇙ (n_mult f)"
apply(rule poly_induct4[of f])
apply (simp add: assms(2))
using assms(1) n_mult_add n_mult_closed smult_closed smult_r_distr apply presburger
using assms apply(intro ext, metis (no_types, lifting) ctrm_smult ltrm_deg_0 P_def R.add.nat_pow_0 UP_cring.ctrm_degree UP_cring.n_mult_closed UP_cring.n_mult_def UP_cring_axioms UP_smult_closed UP_zero_closed zcf_degree_zero zcf_zero deg_const deg_zero le_0_eq monom_closed n_mult_degree_bound smult_r_null)
using monom_mult_smult n_mult_monom assms
by (smt lcf_monom(1) P_def R.add.nat_pow_closed R.add_pow_rdistr R.zero_closed UP_cring.to_poly_mult_simp(1) UP_cring_axioms UP_smult_closed cfs_closed cring_lcf_mult monom_closed to_polynomial_def)
lemma pderiv_smult:
assumes "a ∈ carrier R"
assumes "f ∈ carrier P"
shows "pderiv (a ⊙⇘P⇙ f) = a ⊙⇘P⇙ (pderiv f)"
unfolding pderiv_def
using assms
by (simp add: n_mult_closed nmult_smult poly_shift_s_mult)
lemma(in UP_cring) pderiv_minus:
assumes "a ∈ carrier P"
assumes "b ∈ carrier P"
shows "pderiv (a ⊖⇘P⇙ b) = pderiv a ⊖⇘P⇙ pderiv b"
proof-
have "⊖⇘P⇙ b = (⊖𝟭)⊙⇘P⇙b"
using R.one_closed UP_smult_one assms(2) smult_l_minus by presburger
thus ?thesis unfolding a_minus_def using pderiv_add assms pderiv_smult
by (metis P.add.inv_closed R.add.inv_closed R.one_closed UP_smult_one pderiv_closed smult_l_minus)
qed
lemma(in UP_cring) pderiv_const:
assumes "b ∈ carrier R"
shows "pderiv (up_ring.monom P b 0) = 𝟬⇘P⇙"
using assms pderiv_monom[of b 0] deg_const is_UP_monomE(1) monom_is_UP_monom(1) pderiv_deg_0
by blast
lemma(in UP_cring) pderiv_minus_const:
assumes "a ∈ carrier P"
assumes "b ∈ carrier R"
shows "pderiv (a ⊖⇘P⇙ up_ring.monom P b 0) = pderiv a"
using pderiv_minus[of a "up_ring.monom P b 0" ] assms pderiv_const[of b]
by (smt P.l_zero P.minus_closed P_def UP_cring.pderiv_const UP_cring.pderiv_minus UP_cring.poly_shift_eq UP_cring_axioms cfs_closed monom_closed pderiv_add pderiv_closed poly_shift_id)
lemma(in UP_cring) monom_product_rule:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "pderiv (f ⊗⇘P⇙ up_ring.monom P a n) = f ⊗⇘P⇙ pderiv (up_ring.monom P a n) ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P a n"
proof-
have "∀f. f ∈ carrier P ⟶ pderiv (f ⊗⇘P⇙ up_ring.monom P a n) = f ⊗⇘P⇙ pderiv (up_ring.monom P a n) ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P a n"
proof(induction n)
case 0
show ?case
proof fix f show "f ∈ carrier P ⟶ pderiv (f ⊗⇘P⇙ up_ring.monom P a 0) = f ⊗⇘P⇙ pderiv (up_ring.monom P a 0) ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P a 0 "
proof assume A: "f ∈ carrier P"
have 0: "f ⊗⇘P⇙ up_ring.monom P a 0 = a ⊙⇘P⇙f"
using assms A UP_m_comm is_UP_monomE(1) monom_is_UP_monom(1) monom_mult_is_smult by presburger
have 1: "f ⊗⇘P⇙ pderiv (up_ring.monom P a 0) = 𝟬⇘P⇙"
using A assms P.r_null pderiv_const by presburger
have 2: "pderiv f ⊗⇘P⇙ up_ring.monom P a 0 = a ⊙⇘P⇙ pderiv f"
using assms A UP_m_comm is_UP_monomE(1) monom_is_UP_monom(1) monom_mult_is_smult pderiv_closed by presburger
show "pderiv (f ⊗⇘P⇙ up_ring.monom P a 0) = f ⊗⇘P⇙ pderiv (up_ring.monom P a 0) ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P a 0"
unfolding 0 1 2 using A UP_l_zero UP_smult_closed assms(2) pderiv_closed pderiv_smult by presburger
qed
qed
next
case (Suc n)
show "∀f. f ∈ carrier P ⟶
pderiv (f ⊗⇘P⇙ up_ring.monom P a (Suc n)) = f ⊗⇘P⇙ pderiv (up_ring.monom P a (Suc n)) ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P a (Suc n)"
proof fix f
show "f ∈ carrier P ⟶
pderiv (f ⊗⇘P⇙ up_ring.monom P a (Suc n)) = f ⊗⇘P⇙ pderiv (up_ring.monom P a (Suc n)) ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P a (Suc n)"
proof
assume A: "f ∈ carrier P"
show " pderiv (f ⊗⇘P⇙ up_ring.monom P a (Suc n)) = f ⊗⇘P⇙ pderiv (up_ring.monom P a (Suc n)) ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P a (Suc n)"
proof(cases "n = 0")
case True
have 0: "(f ⊗⇘P⇙ up_ring.monom P a (Suc n)) = a ⊙⇘P⇙ f ⊗⇘P⇙ up_ring.monom P 𝟭 1"
proof -
have "∀n. up_ring.monom P a n ∈ carrier P"
using assms(2) is_UP_monomE(1) monom_is_UP_monom(1) by presburger
then show ?thesis
by (metis A P.m_assoc P.m_comm R.one_closed True assms(2) is_UP_monomE(1) monom_Suc(2) monom_is_UP_monom(1) monom_mult_is_smult)
qed
have 1: "f ⊗⇘P⇙ pderiv (up_ring.monom P a (Suc n)) = a ⊙⇘P⇙ f"
using assms True
by (metis A One_nat_def P.m_comm R.add.nat_pow_eone diff_Suc_1 is_UP_monomE(1) is_UP_monomI monom_mult_is_smult pderiv_monom)
have 2: "pderiv f ⊗⇘P⇙ up_ring.monom P a (Suc n) = a ⊙⇘P⇙ (pderiv f ⊗⇘P⇙ up_ring.monom P 𝟭 1)"
using A assms unfolding True
by (metis P.m_lcomm R.one_closed UP_mult_closed is_UP_monomE(1) monom_Suc(2) monom_is_UP_monom(1) monom_mult_is_smult pderiv_closed)
have 3: "a ⊙⇘P⇙ f ⊕⇘P⇙ a ⊙⇘P⇙ (pderiv f ⊗⇘P⇙ up_ring.monom P 𝟭 1) = a ⊙⇘P⇙ (f ⊕⇘P⇙(pderiv f ⊗⇘P⇙ up_ring.monom P 𝟭 1))"
using assms A P.m_closed R.one_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_closed smult_r_distr by presburger
show ?thesis
unfolding 0 1 2 3
using A times_x_product_rule P.m_closed R.one_closed UP_smult_assoc2 assms(2) is_UP_monomE(1) monom_is_UP_monom(1) pderiv_smult by presburger
next
case False
have IH: "pderiv ((f ⊗⇘P⇙up_ring.monom P 𝟭 1) ⊗⇘P⇙ up_ring.monom P a n) = (f ⊗⇘P⇙up_ring.monom P 𝟭 1) ⊗⇘P⇙ pderiv (up_ring.monom P a n) ⊕⇘P⇙ pderiv (f ⊗⇘P⇙up_ring.monom P 𝟭 1) ⊗⇘P⇙ up_ring.monom P a n"
using Suc A P.m_closed R.one_closed is_UP_monomE(1) is_UP_monomI by presburger
have 0: "f ⊗⇘P⇙ up_ring.monom P a (Suc n) = (f ⊗⇘P⇙up_ring.monom P 𝟭 1) ⊗⇘P⇙ up_ring.monom P a n"
using A R.one_closed UP_m_assoc assms(2) is_UP_monomE(1) monom_Suc(1) monom_is_UP_monom(1) by presburger
have 1: "(f ⊗⇘P⇙up_ring.monom P 𝟭 1) ⊗⇘P⇙ pderiv (up_ring.monom P a n) ⊕⇘P⇙ pderiv (f ⊗⇘P⇙up_ring.monom P 𝟭 1) ⊗⇘P⇙ up_ring.monom P a n =
(f ⊗⇘P⇙up_ring.monom P 𝟭 1) ⊗⇘P⇙ pderiv (up_ring.monom P a n) ⊕⇘P⇙ (f ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P 𝟭 1) ⊗⇘P⇙ up_ring.monom P a n "
using A times_x_product_rule by presburger
have 2: "(f ⊗⇘P⇙up_ring.monom P 𝟭 1) ⊗⇘P⇙ pderiv (up_ring.monom P a n) =(f ⊗⇘P⇙up_ring.monom P ([n]⋅a) n)"
proof-
have 20: "up_ring.monom P ([n] ⋅ a) (n) = up_ring.monom P 𝟭 1 ⊗⇘P⇙ up_ring.monom P ([n] ⋅ a) (n - 1)"
using A assms False monom_mult[of 𝟭 "[n]⋅a" 1 "n-1"]
by (metis R.add.nat_pow_closed R.l_one R.one_closed Suc_eq_plus1 add.commute add_eq_if )
show ?thesis unfolding 20 using assms A False pderiv_monom[of a n]
using P.m_assoc R.one_closed is_UP_monomE(1) monom_is_UP_monom(1) by simp
qed
have 3: "(f ⊗⇘P⇙up_ring.monom P ([n]⋅a) n) = [n]⋅⇘P⇙(f ⊗⇘P⇙up_ring.monom P a n)"
using A assms by (metis P.add_pow_rdistr add_nat_pow_monom is_UP_monomE(1) monom_is_UP_monom(1))
have 4: "pderiv (f ⊗⇘P⇙ up_ring.monom P 𝟭 1) = (f ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P 𝟭 1)"
using times_x_product_rule A by blast
have 5: " (f ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P 𝟭 1) ⊗⇘P⇙ up_ring.monom P a n =
(f ⊗⇘P⇙ up_ring.monom P a n ) ⊕⇘P⇙ (pderiv f ⊗⇘P⇙ up_ring.monom P 𝟭 1 ⊗⇘P⇙ up_ring.monom P a n )"
using A assms by (meson P.l_distr P.m_closed R.one_closed is_UP_monomE(1) is_UP_monomI pderiv_closed)
have 6: " (f ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P 𝟭 1) ⊗⇘P⇙ up_ring.monom P a n =
(f ⊗⇘P⇙ up_ring.monom P a n ) ⊕⇘P⇙ (pderiv f ⊗⇘P⇙ up_ring.monom P 𝟭 1 ⊗⇘P⇙ up_ring.monom P a n )"
using A assms False 5 by blast
have 7: "(f ⊗⇘P⇙up_ring.monom P 𝟭 1) ⊗⇘P⇙ pderiv (up_ring.monom P a n) ⊕⇘P⇙ pderiv (f ⊗⇘P⇙up_ring.monom P 𝟭 1) ⊗⇘P⇙ up_ring.monom P a n =
[(Suc n)] ⋅⇘P⇙ (f ⊗⇘P⇙ up_ring.monom P a n) ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P 𝟭 1 ⊗⇘P⇙ up_ring.monom P a n"
unfolding 2 3 5 6 using assms A P.a_assoc
by (smt "1" "2" "3" "6" P.add.nat_pow_Suc P.m_closed R.one_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_closed)
have 8: "pderiv (f ⊗⇘P⇙ up_ring.monom P a (Suc n)) = pderiv ((f ⊗⇘P⇙up_ring.monom P 𝟭 1) ⊗⇘P⇙ up_ring.monom P a n)"
using A assms 0 by presburger
show " pderiv (f ⊗⇘P⇙ up_ring.monom P a (Suc n)) = f ⊗⇘P⇙ pderiv (up_ring.monom P a (Suc n)) ⊕⇘P⇙ pderiv f ⊗⇘P⇙ up_ring.monom P a (Suc n)"
unfolding 8 IH 0 1 2 3 4 5 6
by (smt "2" "4" "6" "7" A P.add_pow_rdistr R.one_closed UP_m_assoc add_nat_pow_monom assms(2) diff_Suc_1 is_UP_monomE(1) is_UP_monomI monom_Suc(1) pderiv_closed pderiv_monom)
qed
qed
qed
qed
thus ?thesis using assms by blast
qed
lemma(in UP_cring) product_rule:
assumes "f ∈ carrier (UP R)"
assumes "g ∈ carrier (UP R)"
shows "pderiv (f ⊗⇘UP R⇙g) = (pderiv f ⊗⇘UP R⇙ g) ⊕⇘UP R⇙ (f ⊗⇘UP R⇙ pderiv g)"
proof(rule poly_induct3[of f])
show "f ∈ carrier P"
using assms unfolding P_def by blast
show "⋀p q. q ∈ carrier P ⟹
p ∈ carrier P ⟹
pderiv (p ⊗⇘UP R⇙ g) = pderiv p ⊗⇘UP R⇙ g ⊕⇘UP R⇙ p ⊗⇘UP R⇙ pderiv g ⟹
pderiv (q ⊗⇘UP R⇙ g) = pderiv q ⊗⇘UP R⇙ g ⊕⇘UP R⇙ q ⊗⇘UP R⇙ pderiv g ⟹
pderiv ((p ⊕⇘P⇙ q) ⊗⇘UP R⇙ g) = pderiv (p ⊕⇘P⇙ q) ⊗⇘UP R⇙ g ⊕⇘UP R⇙ (p ⊕⇘P⇙ q) ⊗⇘UP R⇙ pderiv g"
proof- fix p q
assume A: "q ∈ carrier P" "p ∈ carrier P"
"pderiv (p ⊗⇘UP R⇙ g) = pderiv p ⊗⇘UP R⇙ g ⊕⇘UP R⇙ p ⊗⇘UP R⇙ pderiv g"
"pderiv (q ⊗⇘UP R⇙ g) = pderiv q ⊗⇘UP R⇙ g ⊕⇘UP R⇙ q ⊗⇘UP R⇙ pderiv g"
have 0: "(p ⊕⇘P⇙ q) ⊗⇘UP R⇙ g = p ⊗⇘UP R⇙ g ⊕⇘UP R⇙ q ⊗⇘UP R⇙ g"
using A assms unfolding P_def using P_def UP_l_distr by blast
have 1: "pderiv ((p ⊕⇘P⇙ q) ⊗⇘UP R⇙ g) = pderiv (p ⊗⇘UP R⇙ g) ⊕⇘UP R⇙ pderiv (q ⊗⇘UP R⇙ g)"
unfolding 0 using pderiv_add[of "p ⊗⇘P⇙ g" "q ⊗⇘P⇙ g"] unfolding P_def
using A(1) A(2) P_def UP_mult_closed assms(2) by blast
have 2: "pderiv ((p ⊕⇘P⇙ q) ⊗⇘UP R⇙ g) = pderiv p ⊗⇘UP R⇙ g ⊕⇘UP R⇙ p ⊗⇘UP R⇙ pderiv g ⊕⇘UP R⇙ (pderiv q ⊗⇘UP R⇙ g ⊕⇘UP R⇙ q ⊗⇘UP R⇙ pderiv g)"
unfolding 1 A by blast
have 3: "pderiv ((p ⊕⇘P⇙ q) ⊗⇘UP R⇙ g) = pderiv p ⊗⇘UP R⇙ g ⊕⇘UP R⇙ pderiv q ⊗⇘UP R⇙ g ⊕⇘UP R⇙ p ⊗⇘UP R⇙ pderiv g ⊕⇘UP R⇙ q ⊗⇘UP R⇙ pderiv g"
using A assms
by (smt "2" P.add.m_lcomm P.m_closed P_def UP_a_assoc pderiv_closed)
have 4: "pderiv ((p ⊕⇘P⇙ q) ⊗⇘UP R⇙ g) = (pderiv p ⊗⇘UP R⇙ g ⊕⇘UP R⇙ pderiv q ⊗⇘UP R⇙ g) ⊕⇘UP R⇙ (p ⊗⇘UP R⇙ pderiv g ⊕⇘UP R⇙ q ⊗⇘UP R⇙ pderiv g)"
unfolding 3 using A assms P_def UP_a_assoc UP_a_closed UP_mult_closed pderiv_closed by auto
have 5: "pderiv ((p ⊕⇘P⇙ q) ⊗⇘UP R⇙ g) = ((pderiv p ⊕⇘UP R⇙ pderiv q) ⊗⇘UP R⇙ g) ⊕⇘UP R⇙ ((p ⊕⇘UP R⇙ q) ⊗⇘UP R⇙ pderiv g)"
unfolding 4 using A assms by (metis P.l_distr P_def pderiv_closed)
have 6: "pderiv ((p ⊕⇘P⇙ q) ⊗⇘UP R⇙ g) = ((pderiv (p ⊕⇘P⇙ q)) ⊗⇘UP R⇙ g) ⊕⇘UP R⇙ ((p ⊕⇘UP R⇙ q) ⊗⇘UP R⇙ pderiv g)"
unfolding 5 using A assms
by (metis P_def pderiv_add)
show "pderiv ((p ⊕⇘P⇙ q) ⊗⇘UP R⇙ g) = pderiv (p ⊕⇘P⇙ q) ⊗⇘UP R⇙ g ⊕⇘UP R⇙ (p ⊕⇘P⇙ q) ⊗⇘UP R⇙ pderiv g"
unfolding 6 using A assms P_def by blast
qed
show "⋀a n. a ∈ carrier R ⟹
pderiv (up_ring.monom P a n ⊗⇘UP R⇙ g) = pderiv (up_ring.monom P a n) ⊗⇘UP R⇙ g ⊕⇘UP R⇙ up_ring.monom P a n ⊗⇘UP R⇙ pderiv g"
using P_def UP_m_comm assms(2) is_UP_monomE(1) monom_is_UP_monom(1) monom_product_rule pderiv_closed by presburger
qed
subsection‹The Chain Rule›
lemma(in UP_cring) chain_rule:
assumes "f ∈ carrier P"
assumes "g ∈ carrier P"
shows "pderiv (compose R f g) = compose R (pderiv f) g ⊗⇘UP R⇙ pderiv g"
proof(rule poly_induct3[of f])
show "f ∈ carrier P"
using assms by blast
show "⋀p q. q ∈ carrier P ⟹
p ∈ carrier P ⟹
pderiv (Cring_Poly.compose R p g) = Cring_Poly.compose R (pderiv p) g ⊗⇘UP R⇙ pderiv g ⟹
pderiv (Cring_Poly.compose R q g) = Cring_Poly.compose R (pderiv q) g ⊗⇘UP R⇙ pderiv g ⟹
pderiv (Cring_Poly.compose R (p ⊕⇘P⇙ q) g) = Cring_Poly.compose R (pderiv (p ⊕⇘P⇙ q)) g ⊗⇘UP R⇙ pderiv g"
using pderiv_add sub_add
by (smt P_def UP_a_closed UP_m_comm UP_r_distr assms(2) pderiv_closed sub_closed)
show "⋀a n. a ∈ carrier R ⟹
pderiv (compose R (up_ring.monom P a n) g) = compose R (pderiv (up_ring.monom P a n)) g ⊗⇘UP R⇙ pderiv g"
proof-
fix a n assume A: "a ∈ carrier R"
show "pderiv (compose R (up_ring.monom P a n) g) = compose R (pderiv (up_ring.monom P a n)) g ⊗⇘UP R⇙ pderiv g"
proof(induction n)
case 0
have 00: "(compose R (up_ring.monom P a 0) g) = (up_ring.monom P a 0)"
using A P_def assms(2) deg_const is_UP_monom_def monom_is_UP_monom(1) sub_const by presburger
have 01: "pderiv (up_ring.monom P a 0) = 𝟬⇘P⇙"
using A pderiv_const by blast
show ?case unfolding 00 01
by (metis P.l_null P_def UP_zero_closed assms(2) deg_zero pderiv_closed sub_const)
next
case (Suc n)
show "pderiv (Cring_Poly.compose R (up_ring.monom P a (Suc n)) g) = Cring_Poly.compose R (pderiv (up_ring.monom P a (Suc n))) g ⊗⇘UP R⇙ pderiv g"
proof(cases "n = 0")
case True
have 0: "compose R (up_ring.monom P a (Suc n)) g = a ⊙⇘P⇙ g"
using A assms sub_monom_deg_one[of g a] unfolding True using One_nat_def
by presburger
have 1: "(pderiv (up_ring.monom P a (Suc n))) = up_ring.monom P a 0"
unfolding True
proof -
have "pderiv (up_ring.monom P a 0) = 𝟬⇘P⇙"
using A pderiv_const by blast
then show "pderiv (up_ring.monom P a (Suc 0)) = up_ring.monom P a 0"
using A lcf_monom(1) P_def X_closed deg_const deg_nzero_nzero is_UP_monomE(1) monom_Suc(2) monom_is_UP_monom(1) monom_rep_X_pow pderiv_monom poly_shift_degree_zero poly_shift_eq sub_monom(2) sub_monom_deg_one to_poly_inverse to_poly_mult_simp(2)
by (metis (no_types, lifting) P.l_null P.r_zero X_poly_def times_x_product_rule)
qed
then show ?thesis unfolding 0 1
using A P_def assms(2) deg_const is_UP_monomE(1) monom_is_UP_monom(1) monom_mult_is_smult pderiv_closed pderiv_smult sub_const
by presburger
next
case False
have 0: "compose R (up_ring.monom P a (Suc n)) g = (compose R (up_ring.monom P a n) g) ⊗⇘P⇙ (compose R (up_ring.monom P 𝟭 1) g)"
using assms A by (metis R.one_closed monom_Suc(2) monom_closed sub_mult)
have 1: "compose R (up_ring.monom P a (Suc n)) g = (compose R (up_ring.monom P a n) g) ⊗⇘P⇙ g"
unfolding 0 using A assms
by (metis P_def R.one_closed UP_cring.lcf_monom(1) UP_cring.to_poly_inverse UP_cring_axioms UP_l_one UP_one_closed deg_one monom_one sub_monom_deg_one to_poly_mult_simp(1))
have 2: "pderiv (compose R (up_ring.monom P a (Suc n)) g ) =
((pderiv (compose R (up_ring.monom P a n) g)) ⊗⇘P⇙ g) ⊕⇘P⇙ ((compose R (up_ring.monom P a n) g) ⊗⇘P⇙ pderiv g)"
unfolding 1 unfolding P_def apply(rule product_rule)
using A assms unfolding P_def using P_def is_UP_monomE(1) is_UP_monomI rev_sub_closed sub_rev_sub apply presburger
using assms unfolding P_def by blast
have 3: "pderiv (compose R (up_ring.monom P a (Suc n)) g ) =
(compose R (pderiv (up_ring.monom P a n)) g ⊗⇘UP R⇙ pderiv g ⊗⇘P⇙ g) ⊕⇘P⇙ ((compose R (up_ring.monom P a n) g) ⊗⇘P⇙ pderiv g)"
unfolding 2 Suc by blast
have 4: "pderiv (compose R (up_ring.monom P a (Suc n)) g ) =
((compose R (pderiv (up_ring.monom P a n)) g ⊗⇘P⇙ g) ⊗⇘UP R⇙ pderiv g) ⊕⇘P⇙ ((compose R (up_ring.monom P a n) g) ⊗⇘P⇙ pderiv g)"
unfolding 3 using A assms m_assoc m_comm
by (smt P_def monom_closed monom_rep_X_pow pderiv_closed sub_closed)
have 5: "pderiv (compose R (up_ring.monom P a (Suc n)) g ) =
((compose R (pderiv (up_ring.monom P a n)) g ⊗⇘P⇙ g) ⊕⇘P⇙ (compose R (up_ring.monom P a n) g)) ⊗⇘P⇙ pderiv g"
unfolding 4 using A assms
by (metis P.l_distr P.m_closed P_def UP_cring.pderiv_closed UP_cring_axioms monom_closed sub_closed)
have 6: "compose R (pderiv (up_ring.monom P a n)) g ⊗⇘P⇙ g = [n]⋅⇘P⇙compose R ((up_ring.monom P a n)) g"
proof-
have 60: "(pderiv (up_ring.monom P a n)) = (up_ring.monom P ([n]⋅a) (n-1))"
using A assms pderiv_monom by blast
have 61: "compose R (pderiv (up_ring.monom P a n)) g ⊗⇘P⇙ g = compose R ((up_ring.monom P ([n]⋅a) (n-1))) g ⊗⇘P⇙ (compose R (up_ring.monom P 𝟭 1) g)"
unfolding 60 using A assms sub_monom_deg_one[of g 𝟭 ] R.one_closed smult_one by presburger
have 62: "compose R (pderiv (up_ring.monom P a n)) g ⊗⇘P⇙ g = compose R (up_ring.monom P ([n]⋅a) n) g"
unfolding 61 using False A assms sub_mult[of g "up_ring.monom P ([n] ⋅ a) (n - 1)" "up_ring.monom P 𝟭 1" ] monom_mult[of "[n]⋅a" 𝟭 "n-1" 1]
by (metis Nat.add_0_right R.add.nat_pow_closed R.one_closed R.r_one Suc_eq_plus1 add_eq_if monom_closed)
have 63: "⋀k::nat. Cring_Poly.compose R (up_ring.monom P ([k] ⋅ a) n) g = [k] ⋅⇘P⇙Cring_Poly.compose R (up_ring.monom P a n) g"
proof- fix k::nat show "Cring_Poly.compose R (up_ring.monom P ([k] ⋅ a) n) g = [k] ⋅⇘P⇙Cring_Poly.compose R (up_ring.monom P a n) g"
apply(induction k)
using UP_zero_closed assms(2) deg_zero monom_zero sub_const
apply (metis A P.add.nat_pow_0 add_nat_pow_monom)
proof-
fix k::nat
assume a: "Cring_Poly.compose R (monom P ([k] ⋅ a) n) g =
[k] ⋅⇘P⇙ Cring_Poly.compose R (monom P a n) g"
have 0: "(monom P ([Suc k] ⋅ a) n) = [Suc k] ⋅ a ⊙⇘P⇙(monom P 𝟭 n)"
by (simp add: A monic_monom_smult)
have 1: "(monom P ([Suc k] ⋅ a) n) = [k] ⋅ a ⊙⇘P⇙(monom P 𝟭 n) ⊕⇘P⇙a ⊙⇘P⇙(monom P 𝟭 n) "
unfolding 0
by (simp add: A UP_smult_l_distr)
show "Cring_Poly.compose R (monom P ([Suc k] ⋅ a) n) g =
[Suc k] ⋅⇘P⇙ (Cring_Poly.compose R (monom P a n) g) "
unfolding 1
by (simp add: A a assms(2) monic_monom_smult sub_add)
qed
qed
have 64: "Cring_Poly.compose R (up_ring.monom P ([n] ⋅ a) n) g = [n] ⋅⇘P⇙Cring_Poly.compose R (up_ring.monom P a n) g"
using 63 by blast
show ?thesis unfolding 62 64 by blast
qed
have 63: "⋀k::nat. Cring_Poly.compose R (up_ring.monom P ([k] ⋅ a) n) g = [k] ⋅⇘P⇙Cring_Poly.compose R (up_ring.monom P a n) g"
proof- fix k::nat show "Cring_Poly.compose R (up_ring.monom P ([k] ⋅ a) n) g = [k] ⋅⇘P⇙Cring_Poly.compose R (up_ring.monom P a n) g"
apply(induction k)
using UP_zero_closed assms(2) deg_zero monom_zero sub_const
apply (metis A P.add.nat_pow_0 add_nat_pow_monom)
using A P.add.nat_pow_Suc add_nat_pow_monom assms(2) is_UP_monomE(1) monom_is_UP_monom(1) rev_sub_add sub_rev_sub
by (metis P.add.nat_pow_closed)
qed
have 7: "([n] ⋅⇘P⇙ Cring_Poly.compose R (up_ring.monom P a n) g ⊕⇘P⇙ Cring_Poly.compose R (up_ring.monom P a n) g) =
[Suc n] ⋅⇘P⇙ (Cring_Poly.compose R (up_ring.monom P a n) g)"
using A assms P.add.nat_pow_Suc by presburger
have 8: "[Suc n] ⋅⇘P⇙ Cring_Poly.compose R (up_ring.monom P a n) g ⊗⇘P⇙ pderiv g = Cring_Poly.compose R (up_ring.monom P ([Suc n] ⋅ a) n) g ⊗⇘P⇙ pderiv g"
unfolding 63[of "Suc n"] by blast
show ?thesis unfolding 5 6 7 8 using A assms pderiv_monom[of "a" "Suc n"]
using P_def diff_Suc_1 by metis
qed
qed
qed
qed
lemma deriv_prod_rule_times_monom:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
assumes "q ∈ carrier P"
shows "deriv ((monom P a n) ⊗⇘P⇙ q) b = (deriv (monom P a n) b) ⊗ (to_fun q b) ⊕ (to_fun (monom P a n) b) ⊗ deriv q b"
proof(rule poly_induct3[of q])
show "q ∈ carrier P"
using assms by simp
show " ⋀p q. q ∈ carrier P ⟹
p ∈ carrier P ⟹
deriv (monom P a n ⊗⇘P⇙ p) b = deriv (monom P a n) b ⊗ to_fun p b ⊕ to_fun (monom P a n) b ⊗ deriv p b ⟹
deriv (monom P a n ⊗⇘P⇙ q) b = deriv (monom P a n) b ⊗ to_fun q b ⊕ to_fun (monom P a n) b ⊗ deriv q b ⟹
deriv (monom P a n ⊗⇘P⇙ (p ⊕⇘P⇙ q)) b = deriv (monom P a n) b ⊗ to_fun (p ⊕⇘P⇙ q) b ⊕ to_fun (monom P a n) b ⊗ deriv (p ⊕⇘P⇙ q) b"
proof- fix p q assume A: "q ∈ carrier P" " p ∈ carrier P"
"deriv (monom P a n ⊗⇘P⇙ p) b = deriv (monom P a n) b ⊗ to_fun p b ⊕ to_fun (monom P a n) b ⊗ deriv p b"
"deriv (monom P a n ⊗⇘P⇙ q) b = deriv (monom P a n) b ⊗ to_fun q b ⊕ to_fun (monom P a n) b ⊗ deriv q b"
have "deriv (monom P a n ⊗⇘P⇙ (p ⊕⇘P⇙ q)) b = deriv (monom P a n) b ⊗ to_fun p b ⊕ to_fun (monom P a n) b ⊗ deriv p b
⊕deriv (monom P a n) b ⊗ to_fun q b ⊕ to_fun (monom P a n) b ⊗ deriv q b"
using A assms
by (simp add: P.r_distr R.add.m_assoc deriv_add deriv_closed to_fun_closed)
hence "deriv (monom P a n ⊗⇘P⇙ (p ⊕⇘P⇙ q)) b = deriv (monom P a n) b ⊗ to_fun p b ⊕deriv (monom P a n) b ⊗ to_fun q b
⊕ to_fun (monom P a n) b ⊗ deriv p b ⊕ to_fun (monom P a n) b ⊗ deriv q b"
using A(1) A(2) R.add.m_assoc R.add.m_comm assms(1) assms(2) deriv_closed to_fun_closed by auto
hence "deriv (monom P a n ⊗⇘P⇙ (p ⊕⇘P⇙ q)) b = deriv (monom P a n) b ⊗ (to_fun p b ⊕ to_fun q b)
⊕ to_fun (monom P a n) b ⊗ (deriv p b ⊕ deriv q b)"
by (simp add: A(1) A(2) R.add.m_assoc R.r_distr assms(1) assms(2) deriv_closed to_fun_closed)
thus "deriv (monom P a n ⊗⇘P⇙ (p ⊕⇘P⇙ q)) b = deriv (monom P a n) b ⊗ to_fun (p ⊕⇘P⇙ q) b ⊕ to_fun (monom P a n) b ⊗ deriv (p ⊕⇘P⇙ q) b"
by (simp add: A(1) A(2) assms(2) deriv_add to_fun_plus)
qed
show "⋀c m. c ∈ carrier R ⟹ deriv (monom P a n ⊗⇘P⇙ monom P c m) b =
deriv (monom P a n) b ⊗ to_fun (monom P c m) b
⊕ to_fun (monom P a n) b ⊗ deriv (monom P c m) b"
proof- fix c m assume A: "c ∈ carrier R"
show "deriv (monom P a n ⊗⇘P⇙ monom P c m) b = deriv (monom P a n) b ⊗ to_fun (monom P c m) b ⊕ to_fun (monom P a n) b ⊗ deriv (monom P c m) b"
proof(cases "n = 0")
case True
have LHS: "deriv (monom P a n ⊗⇘P⇙ monom P c m) b = deriv (monom P (a ⊗ c) m) b"
by (metis A True add.left_neutral assms(1) monom_mult)
have RHS: "deriv (monom P a n) b ⊗ to_fun (monom P c m) b ⊕ to_fun (monom P a n) b ⊗ deriv (monom P c m) b
= a ⊗ deriv (monom P c m) b "
using deriv_const to_fun_monom A True assms(1) assms(2) deriv_closed by auto
show ?thesis using A assms LHS RHS deriv_monom
by (smt R.add.nat_pow_closed R.add_pow_rdistr R.m_assoc R.m_closed R.nat_pow_closed)
next
case False
show ?thesis
proof(cases "m = 0")
case True
have LHS: "deriv (monom P a n ⊗⇘P⇙ monom P c m) b = deriv (monom P (a ⊗ c) n) b"
by (metis A True add.comm_neutral assms(1) monom_mult)
have RHS: "deriv (monom P a n) b ⊗ to_fun (monom P c m) b ⊕ to_fun (monom P a n) b ⊗ deriv (monom P c m) b
= c ⊗ deriv (monom P a n) b "
by (metis (no_types, lifting) A lcf_monom(1) P_def R.m_closed R.m_comm R.r_null
R.r_zero True UP_cring.to_fun_ctrm UP_cring_axioms assms(1) assms(2) deg_const
deriv_closed deriv_const to_fun_closed monom_closed)
show ?thesis using LHS RHS deriv_monom A assms
by (smt R.add.nat_pow_closed R.add_pow_ldistr R.m_assoc R.m_closed R.m_comm R.nat_pow_closed)
next
case F: False
have pos: "n > 0" "m >0"
using F False by auto
have RHS: "deriv (monom P a n ⊗⇘P⇙ monom P c m) b = [(n + m)] ⋅ (a ⊗ c) ⊗ b [^] (n + m - 1)"
using deriv_monom[of "a ⊗ c" b "n + m"] monom_mult[of a c n m]
by (simp add: A assms(1) assms(2))
have LHS: "deriv (monom P a n) b ⊗ to_fun (monom P c m) b ⊕ to_fun (monom P a n) b ⊗ deriv (monom P c m) b
= [n]⋅a ⊗(b[^](n-1)) ⊗ c ⊗ b[^]m ⊕ a ⊗ b[^]n ⊗ [m]⋅c ⊗(b[^](m-1))"
using deriv_monom[of a b n] to_fun_monom[of a b n]
deriv_monom[of c b m] to_fun_monom[of c b m] A assms
by (simp add: R.m_assoc)
have 0: "[n]⋅a ⊗ (b[^](n-1)) ⊗ c ⊗ b[^]m = [n]⋅a ⊗ c ⊗ b[^](n + m -1) "
proof-
have "[n]⋅a ⊗ (b[^](n-1)) ⊗ c ⊗ b[^]m = [n]⋅a ⊗ c ⊗ (b[^](n-1)) ⊗ b[^]m"
by (simp add: A R.m_lcomm R.semiring_axioms assms(1) assms(2) semiring.semiring_simprules(8))
hence "[n]⋅a ⊗ (b[^](n-1)) ⊗ c ⊗ b[^]m = [n]⋅a ⊗ c ⊗ ((b[^](n-1)) ⊗ b[^]m)"
by (simp add: A R.m_assoc assms(1) assms(2))
thus ?thesis
by (simp add: False R.nat_pow_mult add_eq_if assms(2))
qed
have 1: "a ⊗ b[^]n ⊗ [m]⋅c ⊗(b[^](m-1)) = a ⊗ [m]⋅c ⊗ b[^](n + m -1)"
proof-
have "a ⊗ b[^]n ⊗ [m]⋅c ⊗(b[^](m-1)) = a ⊗ [m]⋅c ⊗ b[^]n ⊗(b[^](m-1))"
using A R.m_comm R.m_lcomm assms(1) assms(2) by auto
hence "a ⊗ b[^]n ⊗ [m]⋅c ⊗(b[^](m-1)) = a ⊗ [m]⋅c ⊗ (b[^]n ⊗(b[^](m-1)))"
by (simp add: A R.m_assoc assms(1) assms(2))
thus ?thesis
by (simp add: F R.nat_pow_mult add.commute add_eq_if assms(2))
qed
have LHS: "deriv (monom P a n) b ⊗ to_fun (monom P c m) b ⊕ to_fun (monom P a n) b ⊗ deriv (monom P c m) b
= [n]⋅a ⊗ c ⊗ b[^](n + m -1) ⊕ a ⊗ [m]⋅c ⊗ b[^](n + m -1)"
using LHS 0 1
by simp
hence LHS: "deriv (monom P a n) b ⊗ to_fun (monom P c m) b ⊕ to_fun (monom P a n) b ⊗ deriv (monom P c m) b
= [n]⋅ (a ⊗ c ⊗ b[^](n + m -1)) ⊕ [m]⋅ (a ⊗ c ⊗ b[^](n + m -1))"
by (simp add: A R.add_pow_ldistr R.add_pow_rdistr assms(1) assms(2))
show ?thesis using LHS RHS
by (simp add: A R.add.nat_pow_mult R.add_pow_ldistr assms(1) assms(2))
qed
qed
qed
qed
lemma deriv_prod_rule:
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
assumes "a ∈ carrier R"
shows "deriv (p ⊗⇘P⇙ q) a = deriv p a ⊗ (to_fun q a) ⊕ (to_fun p a) ⊗ deriv q a"
proof(rule poly_induct3[of p])
show "p ∈ carrier P"
using assms(1) by simp
show " ⋀p qa.
qa ∈ carrier P ⟹
p ∈ carrier P ⟹
deriv (p ⊗⇘P⇙ q) a = deriv p a ⊗ to_fun q a ⊕ to_fun p a ⊗ deriv q a ⟹
deriv (qa ⊗⇘P⇙ q) a = deriv qa a ⊗ to_fun q a ⊕ to_fun qa a ⊗ deriv q a ⟹
deriv ((p ⊕⇘P⇙ qa) ⊗⇘P⇙ q) a = deriv (p ⊕⇘P⇙ qa) a ⊗ to_fun q a ⊕ to_fun (p ⊕⇘P⇙ qa) a ⊗ deriv q a"
proof- fix f g assume A: "f ∈ carrier P" "g ∈ carrier P"
"deriv (f ⊗⇘P⇙ q) a = deriv f a ⊗ to_fun q a ⊕ to_fun f a ⊗ deriv q a"
"deriv (g ⊗⇘P⇙ q) a = deriv g a ⊗ to_fun q a ⊕ to_fun g a ⊗ deriv q a"
have "deriv ((f ⊕⇘P⇙ g) ⊗⇘P⇙ q) a = deriv f a ⊗ to_fun q a ⊕ to_fun f a ⊗ deriv q a ⊕
deriv g a ⊗ to_fun q a ⊕ to_fun g a ⊗ deriv q a"
using A deriv_add
by (simp add: P.l_distr R.add.m_assoc assms(2) assms(3) deriv_closed to_fun_closed)
hence "deriv ((f ⊕⇘P⇙ g) ⊗⇘P⇙ q) a = deriv f a ⊗ to_fun q a ⊕ deriv g a ⊗ to_fun q a ⊕
to_fun f a ⊗ deriv q a ⊕ to_fun g a ⊗ deriv q a"
using R.a_comm R.a_assoc deriv_closed to_fun_closed assms
by (simp add: A(1) A(2))
hence "deriv ((f ⊕⇘P⇙ g) ⊗⇘P⇙ q) a = (deriv f a ⊗ to_fun q a ⊕ deriv g a ⊗ to_fun q a) ⊕
(to_fun f a ⊗ deriv q a ⊕ to_fun g a ⊗ deriv q a)"
by (simp add: A(1) A(2) R.add.m_assoc assms(2) assms(3) deriv_closed to_fun_closed)
thus "deriv ((f ⊕⇘P⇙ g) ⊗⇘P⇙ q) a = deriv (f ⊕⇘P⇙ g) a ⊗ to_fun q a ⊕ to_fun (f ⊕⇘P⇙ g) a ⊗ deriv q a"
by (simp add: A(1) A(2) R.l_distr assms(2) assms(3) deriv_add deriv_closed to_fun_closed to_fun_plus)
qed
show "⋀aa n. aa ∈ carrier R ⟹ deriv (monom P aa n ⊗⇘P⇙ q) a = deriv (monom P aa n) a ⊗ to_fun q a ⊕ to_fun (monom P aa n) a ⊗ deriv q a"
using deriv_prod_rule_times_monom
by (simp add: assms(2) assms(3))
qed
lemma pderiv_eval_deriv_monom:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "to_fun (pderiv (monom P a n)) b = deriv (monom P a n) b"
using deriv_monom assms pderiv_monom
by (simp add: P_def UP_cring.to_fun_monom UP_cring_axioms)
lemma pderiv_eval_deriv:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "deriv f a = to_fun (pderiv f) a"
apply(rule poly_induct3[of f])
apply (simp add: assms(1))
using assms(2) deriv_add to_fun_plus pderiv_add pderiv_closed apply presburger
using assms(2) pderiv_eval_deriv_monom
by presburger
text‹Taking taylor expansions commutes with taking derivatives:›
lemma(in UP_cring) taylor_expansion_pderiv_comm:
assumes "f ∈ carrier (UP R)"
assumes "c ∈ carrier R"
shows "pderiv (taylor_expansion R c f) = taylor_expansion R c (pderiv f)"
apply(rule poly_induct3[of f])
using assms unfolding P_def apply blast
proof-
fix p q assume A: " q ∈ carrier (UP R)" "p ∈ carrier (UP R)"
"pderiv (taylor_expansion R c p) = taylor_expansion R c (pderiv p)"
"pderiv (taylor_expansion R c q) = taylor_expansion R c (pderiv q)"
have 0: " pderiv (taylor_expansion R c (p ⊕⇘UP R⇙ q)) = pderiv (taylor_expansion R c p ⊕⇘UP R⇙ taylor_expansion R c q)"
using A P_def taylor_expansion_add assms(2) by presburger
show "pderiv (taylor_expansion R c (p ⊕⇘UP R⇙ q)) = taylor_expansion R c (pderiv (p ⊕⇘UP R⇙ q))"
unfolding 0
using A(1) A(2) A(3) A(4) taylor_def UP_cring.taylor_closed UP_cring.taylor_expansion_add UP_cring.pderiv_add UP_cring.pderiv_closed UP_cring_axioms assms(2) by fastforce
next
fix a n assume A: "a ∈ carrier R"
show "pderiv (taylor_expansion R c (up_ring.monom (UP R) a n)) = taylor_expansion R c (pderiv (up_ring.monom (UP R) a n))"
proof(cases "n = 0")
case True
have 0: "deg R (taylor_expansion R c (up_ring.monom (UP R) a n)) = 0"
unfolding True
using P_def A assms taylor_def taylor_deg deg_const is_UP_monomE(1) monom_is_UP_monom(2) by presburger
have 1: "(pderiv (up_ring.monom (UP R) a n)) = 𝟬⇘P⇙"
unfolding True using P_def A assms pderiv_const by blast
show ?thesis unfolding 1 using 0 A assms P_def
by (metis P.add.right_cancel taylor_closed taylor_def taylor_expansion_add UP_l_zero UP_zero_closed monom_closed pderiv_deg_0)
next
case False
have 0: "pderiv (up_ring.monom (UP R) a n) = (up_ring.monom (UP R) ([n]⋅a) (n-1))"
using A
by (simp add: UP_cring.pderiv_monom UP_cring_axioms)
have 1: "pderiv (taylor_expansion R c (up_ring.monom (UP R) a n)) = (Cring_Poly.compose R (up_ring.monom (UP R) ([n]⋅a) (n-1)) (X_plus c)) ⊗⇘P⇙ pderiv (X_plus c)"
using chain_rule[of "up_ring.monom (UP R) a n" "X_plus c"] unfolding 0 taylor_expansion_def
using A P_def X_plus_closed assms(2) is_UP_monom_def monom_is_UP_monom(1) by presburger
have 2: "pderiv (X_plus c) = 𝟭⇘P⇙"
using pderiv_add[of "X_poly R" "to_poly c"] P.l_null P.l_one P.r_zero P_def R.one_closed X_closed
X_poly_def X_poly_plus_def assms(2) monom_one pderiv_const to_poly_closed to_polynomial_def
by (metis times_x_product_rule)
show ?thesis unfolding 1 0 2 taylor_expansion_def
by (metis "1" "2" A P.l_one P_def R.add.nat_pow_closed UP_m_comm UP_one_closed X_plus_closed assms(2) monom_closed sub_closed taylor_expansion_def)
qed
qed
subsection‹Linear Substitutions›
lemma(in UP_ring) lcoeff_Lcf:
assumes "f ∈ carrier P"
shows "lcoeff f = lcf f"
unfolding P_def
using assms coeff_simp[of f] by metis
lemma(in UP_cring) linear_sub_cfs:
assumes "f ∈ carrier (UP R)"
assumes "d ∈ carrier R"
assumes "g = compose R f (up_ring.monom (UP R) d 1)"
shows "g i = d[^]i ⊗ f i"
proof-
have 0: "(up_ring.monom (UP R) d 1) ∈ carrier (UP R)"
using assms by (meson R.ring_axioms UP_ring.intro UP_ring.monom_closed)
have 1: "(∀i. compose R f (up_ring.monom (UP R) d 1) i = d[^]i ⊗ f i)"
apply(rule poly_induct3[of f])
using assms unfolding P_def apply blast
proof-
show "⋀p q. q ∈ carrier (UP R) ⟹
p ∈ carrier (UP R) ⟹
∀i. Cring_Poly.compose R p (up_ring.monom (UP R) d 1) i = d [^] i ⊗ p i ⟹
∀i. Cring_Poly.compose R q (up_ring.monom (UP R) d 1) i = d [^] i ⊗ q i ⟹
∀i. Cring_Poly.compose R (p ⊕⇘UP R⇙ q) (up_ring.monom (UP R) d 1) i = d [^] i ⊗ (p ⊕⇘UP R⇙ q) i"
proof
fix p q i
assume A: "q ∈ carrier (UP R)"
"p ∈ carrier (UP R)"
"∀i. Cring_Poly.compose R p (up_ring.monom (UP R) d 1) i = d [^] i ⊗ p i"
"∀i. Cring_Poly.compose R q (up_ring.monom (UP R) d 1) i = d [^] i ⊗ q i"
show "Cring_Poly.compose R (p ⊕⇘UP R⇙ q) (up_ring.monom (UP R) d 1) i = d [^] i ⊗ (p ⊕⇘UP R⇙ q) i"
proof-
have 1: "Cring_Poly.compose R (p ⊕⇘UP R⇙ q) (up_ring.monom (UP R) d 1) =
Cring_Poly.compose R p (up_ring.monom (UP R) d 1) ⊕⇘UP R⇙ Cring_Poly.compose R q (up_ring.monom (UP R) d 1)"
using A(1) A(2) sub_add[of "up_ring.monom (UP R) d 1" q p] unfolding P_def
using "0" P_def sub_add by blast
have 2: "Cring_Poly.compose R (p ⊕⇘UP R⇙ q) (up_ring.monom (UP R) d 1) i =
Cring_Poly.compose R p (up_ring.monom (UP R) d 1) i ⊕ Cring_Poly.compose R q (up_ring.monom (UP R) d 1) i"
using 1 by (metis (no_types, lifting) "0" A(1) A(2) P_def cfs_add sub_closed)
have 3: "Cring_Poly.compose R (p ⊕⇘UP R⇙ q) (up_ring.monom (UP R) d 1) i = d [^] i ⊗ p i ⊕ d [^] i ⊗ q i"
unfolding 2 using A by presburger
have 4: "Cring_Poly.compose R (p ⊕⇘UP R⇙ q) (up_ring.monom (UP R) d 1) i = d [^] i ⊗ (p i ⊕ q i)"
using "3" A(1) A(2) R.nat_pow_closed R.r_distr UP_car_memE(1) assms(2) by presburger
thus "Cring_Poly.compose R (p ⊕⇘UP R⇙ q) (up_ring.monom (UP R) d 1) i = d [^] i ⊗ (p ⊕⇘UP R⇙ q) i"
unfolding 4 using A(1) A(2) P_def cfs_add by presburger
qed
qed
show "⋀a n. a ∈ carrier R ⟹
∀i. Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1) i = d [^] i ⊗ up_ring.monom (UP R) a n i"
proof fix a n i assume A: "a ∈ carrier R"
have 0: "Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1) =
a ⊙⇘UP R⇙(up_ring.monom (UP R) d 1)[^]⇘UP R⇙n"
using assms A 0 P_def monom_sub by blast
have 1: "Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1) =
a ⊙⇘UP R⇙ (d[^]n ⊙⇘UP R⇙(up_ring.monom (UP R) 𝟭 n))"
unfolding 0 using A assms
by (metis P_def R.nat_pow_closed monic_monom_smult monom_pow mult.left_neutral)
have 2: "Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1) =
(a ⊗d[^]n)⊙⇘UP R⇙(up_ring.monom (UP R) 𝟭 n)"
unfolding 1 using A assms
by (metis R.nat_pow_closed R.one_closed R.ring_axioms UP_ring.UP_smult_assoc1 UP_ring.intro UP_ring.monom_closed)
show "Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1) i = d [^] i ⊗ up_ring.monom (UP R) a n i"
apply(cases "i = n")
unfolding 2 using A P_def R.m_closed R.m_comm R.nat_pow_closed assms(2) cfs_monom monic_monom_smult apply presburger
using A P_def R.m_closed R.nat_pow_closed R.r_null assms(2) cfs_monom monic_monom_smult by presburger
qed
qed
show ?thesis using 1 unfolding assms
by blast
qed
lemma(in UP_cring) linear_sub_deriv:
assumes "f ∈ carrier (UP R)"
assumes "d ∈ carrier R"
assumes "g = compose R f (up_ring.monom (UP R) d 1)"
assumes "c ∈ carrier R"
shows "pderiv g = d ⊙⇘UP R⇙ compose R (pderiv f) (up_ring.monom (UP R) d 1)"
unfolding assms
proof(rule poly_induct3[of f])
show "f ∈ carrier P"
using assms unfolding P_def by blast
show "⋀ p q. q ∈ carrier P ⟹
p ∈ carrier P ⟹
pderiv (Cring_Poly.compose R p (up_ring.monom (UP R) d 1)) = d ⊙⇘UP R⇙ Cring_Poly.compose R (pderiv p) (up_ring.monom (UP R) d 1) ⟹
pderiv (Cring_Poly.compose R q (up_ring.monom (UP R) d 1)) = d ⊙⇘UP R⇙ Cring_Poly.compose R (pderiv q) (up_ring.monom (UP R) d 1) ⟹
pderiv (Cring_Poly.compose R (p ⊕⇘P⇙ q) (up_ring.monom (UP R) d 1)) =
d ⊙⇘UP R⇙ Cring_Poly.compose R (pderiv (p ⊕⇘P⇙ q)) (up_ring.monom (UP R) d 1)"
proof- fix p q assume A: "q ∈ carrier P" "p ∈ carrier P"
"pderiv (Cring_Poly.compose R p (up_ring.monom (UP R) d 1)) = d ⊙⇘UP R⇙ Cring_Poly.compose R (pderiv p) (up_ring.monom (UP R) d 1)"
"pderiv (Cring_Poly.compose R q (up_ring.monom (UP R) d 1)) = d ⊙⇘UP R⇙ Cring_Poly.compose R (pderiv q) (up_ring.monom (UP R) d 1)"
show " pderiv (Cring_Poly.compose R (p ⊕⇘P⇙ q) (up_ring.monom (UP R) d 1)) =
d ⊙⇘UP R⇙ Cring_Poly.compose R (pderiv (p ⊕⇘P⇙ q)) (up_ring.monom (UP R) d 1)"
using A assms
by (smt P_def UP_a_closed UP_r_distr monom_closed monom_mult_is_smult pderiv_add pderiv_closed rev_sub_add sub_closed sub_rev_sub)
qed
show "⋀a n. a ∈ carrier R ⟹
pderiv (Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) =
d ⊙⇘UP R⇙ Cring_Poly.compose R (pderiv (up_ring.monom P a n)) (up_ring.monom (UP R) d 1)"
proof- fix a n assume A: "a ∈ carrier R"
have "(Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = a ⊙⇘UP R⇙ (up_ring.monom P d 1)[^]⇘UP R⇙ n"
using A assms sub_monom(2) P_def is_UP_monomE(1) monom_is_UP_monom(1) by blast
hence 0: "(Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = a ⊙⇘UP R⇙ (up_ring.monom P (d[^]n) n)"
using A assms P_def monom_pow nat_mult_1 by metis
show "pderiv (Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) =
d ⊙⇘UP R⇙ Cring_Poly.compose R (pderiv (up_ring.monom P a n)) (up_ring.monom (UP R) d 1)"
proof(cases "n = 0")
case True
have T0: "pderiv (up_ring.monom P a n) = 𝟬⇘ UP R⇙" unfolding True
using A P_def pderiv_const by blast
have T1: "(Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = up_ring.monom P a n"
unfolding True
using A assms P_def deg_const is_UP_monomE(1) monom_is_UP_monom(1) sub_const by presburger
thus ?thesis unfolding T0 T1
by (metis P.nat_pow_eone P_def UP_smult_closed UP_zero_closed X_closed assms(2) deg_zero monom_rep_X_pow smult_r_null sub_const)
next
case False
have F0: "pderiv (Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = (a ⊙⇘UP R⇙ (up_ring.monom P ([n]⋅⇘R⇙(d[^]n))(n-1)))"
using A assms pderiv_monom unfolding 0
using P_def R.nat_pow_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_smult by metis
have F1: "(pderiv (up_ring.monom P a n)) = up_ring.monom P ([n] ⋅ a) (n - 1)"
using A assms pderiv_monom[of a n] by blast
hence F2: "(pderiv (up_ring.monom P a n)) = ([n] ⋅ a) ⊙⇘UP R⇙up_ring.monom P 𝟭 (n - 1)"
using A P_def monic_monom_smult by auto
have F3: "Cring_Poly.compose R ((([n] ⋅ a) ⊙⇘UP R⇙ (up_ring.monom P 𝟭 (n - 1)))) (up_ring.monom (UP R) d 1) =
([n] ⋅ a) ⊙⇘UP R⇙ ((up_ring.monom (UP R) d 1)[^]⇘UP R⇙(n-1))"
using A F1 F2 P_def assms(2) monom_closed sub_monom(2) by fastforce
have F4: "Cring_Poly.compose R ((([n] ⋅ a) ⊙⇘UP R⇙ (up_ring.monom P 𝟭 (n - 1)))) (up_ring.monom (UP R) d 1) =
([n] ⋅ a) ⊙⇘UP R⇙ ((up_ring.monom (UP R) (d[^](n-1)) (n-1)))"
by (metis F3 P_def assms(2) monom_pow nat_mult_1)
have F5: "d ⊙⇘UP R⇙ (Cring_Poly.compose R (pderiv (up_ring.monom P a n)) (up_ring.monom (UP R) d 1)) =
(d ⊗([n] ⋅ a)) ⊙⇘UP R⇙ up_ring.monom (UP R) (d [^] (n - 1)) (n - 1)"
unfolding F4 F2
using A P_def assms(2) monom_closed smult_assoc1 by auto
have F6: "d ⊙⇘UP R⇙ (Cring_Poly.compose R (pderiv (up_ring.monom P a n)) (up_ring.monom (UP R) d 1)) =
(d ⊗ d[^](n-1) ⊗[n] ⋅ a) ⊙⇘UP R⇙ ((up_ring.monom (UP R) 𝟭 (n-1)))"
unfolding F5 using False A assms P_def R.m_assoc R.m_closed R.m_comm R.nat_pow_closed monic_monom_smult monom_mult_smult
by (smt R.add.nat_pow_closed)
have F7: "pderiv (Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = (a ⊗ ([n]⋅⇘R⇙(d[^]n)) ⊙⇘UP R⇙ (up_ring.monom P 𝟭 (n-1)))"
unfolding F0 using A assms P_def R.m_closed R.nat_pow_closed monic_monom_smult monom_mult_smult
by simp
have F8: "a ⊗ [n] ⋅ (d [^] n) = d ⊗ d [^] (n - 1) ⊗ [n] ⋅ a"
proof-
have F80: "d ⊗ d [^] (n - 1) ⊗ [n] ⋅ a = d [^] n ⊗ [n] ⋅ a"
using A assms False by (metis R.nat_pow_Suc2 add.right_neutral add_eq_if)
show ?thesis unfolding F80
using A R.add_pow_rdistr R.m_comm R.nat_pow_closed assms(2) by presburger
qed
show ?thesis unfolding F6 F7 unfolding F8 P_def by blast
qed
qed
qed
lemma(in UP_cring) linear_sub_deriv':
assumes "f ∈ carrier (UP R)"
assumes "d ∈ carrier R"
assumes "g = compose R f (up_ring.monom (UP R) d 1)"
assumes "c ∈ carrier R"
shows "pderiv g = compose R (d ⊙⇘UP R⇙ pderiv f) (up_ring.monom (UP R) d 1)"
using assms linear_sub_deriv[of f d g c] P_def is_UP_monomE(1) is_UP_monomI pderiv_closed sub_smult by metis
lemma(in UP_cring) linear_sub_inv:
assumes "f ∈ carrier (UP R)"
assumes "d ∈ Units R"
assumes "g = compose R f (up_ring.monom (UP R) d 1)"
shows "compose R g (up_ring.monom (UP R) (inv d) 1) = f"
unfolding assms
proof fix x
have 0: "Cring_Poly.compose R (Cring_Poly.compose R f (up_ring.monom (UP R) d 1)) (up_ring.monom (UP R) (inv d) 1) x =
(inv d)[^]x ⊗ ((Cring_Poly.compose R f (up_ring.monom (UP R) d 1)) x)"
apply(rule linear_sub_cfs)
using P_def R.Units_closed assms(1) assms(2) monom_closed sub_closed apply auto[1]
apply (simp add: assms(2))
by blast
show "Cring_Poly.compose R (Cring_Poly.compose R f (up_ring.monom (UP R) d 1)) (up_ring.monom (UP R) (inv d) 1) x = f x "
unfolding 0 using linear_sub_cfs[of f d "Cring_Poly.compose R f (up_ring.monom (UP R) d 1)" x]
assms
by (smt R.Units_closed R.Units_inv_closed R.Units_l_inv R.m_assoc R.m_comm R.nat_pow_closed R.nat_pow_distrib R.nat_pow_one R.r_one UP_car_memE(1))
qed
lemma(in UP_cring) linear_sub_deg:
assumes "f ∈ carrier (UP R)"
assumes "d ∈ Units R"
assumes "g = compose R f (up_ring.monom (UP R) d 1)"
shows "deg R g = deg R f"
proof(cases "deg R f = 0")
case True
show ?thesis using assms
unfolding True assms using P_def True monom_closed
by (simp add: R.Units_closed sub_const)
next
case False
have 0: "monom (UP R) d 1 (deg R (monom (UP R) d 1)) = d"
using assms lcf_monom(2) by blast
have 1: "d[^](deg R f) ∈ Units R"
using assms(2)
by (metis Group.comm_monoid.axioms(1) R.units_comm_group R.units_of_pow comm_group_def monoid.nat_pow_closed units_of_carrier)
have 2: "f (deg R f) ≠ 𝟬"
using assms False P_def UP_cring.ltrm_rep_X_pow UP_cring_axioms deg_ltrm degree_monom by fastforce
have "deg R g = deg R f * deg R (up_ring.monom (UP R) d 1)"
unfolding assms
apply(rule cring_sub_deg[of "up_ring.monom (UP R) d 1" f] )
using assms P_def monom_closed apply blast
unfolding P_def apply(rule assms)
unfolding 0 using 2 1
by (metis R.Units_closed R.Units_l_cancel R.m_comm R.r_null R.zero_closed UP_car_memE(1) assms(1))
thus ?thesis using assms unfolding assms
by (metis (no_types, lifting) P_def R.Units_closed deg_monom deg_zero is_UP_monomE(1) linear_sub_inv monom_is_UP_monom(2) monom_zero mult.right_neutral mult_0_right sub_closed sub_const)
qed
end
section‹Lemmas About Polynomial Division›
context UP_cring
begin
subsection‹Division by Linear Terms›
definition UP_root_div where
"UP_root_div f a = (poly_shift (T⇘a⇙ f)) of (X_minus a)"
definition UP_root_rem where
"UP_root_rem f a = ctrm (T⇘a⇙ f)"
lemma UP_root_div_closed:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "UP_root_div f a ∈ carrier P"
using assms
unfolding UP_root_div_def
by (simp add: taylor_closed X_minus_closed poly_shift_closed sub_closed)
lemma rem_closed:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "UP_root_rem f a ∈ carrier P"
using assms
unfolding UP_root_rem_def
by (simp add: taylor_closed ctrm_is_poly)
lemma rem_deg:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "degree (UP_root_rem f a) = 0"
by (simp add: taylor_closed assms(1) assms(2) ctrm_degree UP_root_rem_def)
lemma remainder_theorem:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
assumes "g = UP_root_div f a"
assumes "r = UP_root_rem f a"
shows "f = r ⊕⇘P⇙ (X_minus a) ⊗⇘P⇙ g"
proof-
have "T⇘a⇙f = (ctrm (T⇘a⇙f)) ⊕⇘P⇙ X ⊗⇘P⇙ poly_shift (T⇘a⇙f)"
using poly_shift_eq[of "T⇘a⇙f"] assms taylor_closed
by blast
hence 1: "T⇘a⇙f of (X_minus a) = (ctrm (T⇘a⇙f)) ⊕⇘P⇙ (X_minus a) ⊗⇘P⇙ (poly_shift (T⇘a⇙f) of (X_minus a))"
using assms taylor_closed[of f a] X_minus_closed[of a] X_closed
sub_add[of "X_minus a" "ctrm (T⇘a⇙f)" "X ⊗⇘P⇙ poly_shift (T⇘a⇙f)"]
sub_const[of "X_minus a"] sub_mult[of "X_minus a" X "poly_shift (T⇘a⇙f)"]
ctrm_degree ctrm_is_poly P.m_closed poly_shift_closed sub_X
by presburger
have 2: "f = (ctrm (T⇘a⇙f)) ⊕⇘P⇙ (X_minus a) ⊗⇘P⇙ (poly_shift (T⇘a⇙f) of (X_minus a))"
using 1 taylor_id[of a f] assms
by simp
then show ?thesis
using assms
unfolding UP_root_div_def UP_root_rem_def
by auto
qed
lemma remainder_theorem':
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
shows "f = UP_root_rem f a ⊕⇘P⇙ (X_minus a) ⊗⇘P⇙ UP_root_div f a"
using assms remainder_theorem by auto
lemma factor_theorem:
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
assumes "g = UP_root_div f a"
assumes "to_fun f a = 𝟬"
shows "f = (X_minus a) ⊗⇘P⇙ g"
using remainder_theorem[of f a g _] assms
unfolding UP_root_rem_def
by (simp add: ctrm_zcf taylor_zcf taylor_closed UP_root_div_closed X_minus_closed)
lemma factor_theorem':
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
assumes "to_fun f a = 𝟬"
shows "f = (X_minus a) ⊗⇘P⇙ UP_root_div f a"
by (simp add: assms(1) assms(2) assms(3) factor_theorem)
subsection‹Geometric Sums›
lemma geom_quot:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
assumes "p = monom P 𝟭 (Suc n) ⊖⇘P⇙ monom P (b[^](Suc n)) 0 "
assumes "g = UP_root_div p b"
shows "a[^](Suc n) ⊖ b[^] (Suc n) = (a ⊖ b) ⊗ (to_fun g a)"
proof-
have root: "to_fun p b = 𝟬"
using assms to_fun_const[of "b[^](Suc n)" b] to_fun_monic_monom[of b "Suc n"] R.nat_pow_closed[of b "Suc n"]
to_fun_diff[of "monom P 𝟭 (Suc n)" "monom P (b[^](Suc n)) 0" b] monom_closed
by (metis P.minus_closed P_def R.one_closed R.zero_closed UP_cring.f_minus_ctrm
UP_cring.to_fun_diff UP_cring_axioms zcf_to_fun cfs_monom to_fun_const)
have LHS: "to_fun p a = a[^](Suc n) ⊖ b[^] (Suc n)"
using assms to_fun_const to_fun_monic_monom to_fun_diff
by auto
have RHS: "to_fun ((X_minus b) ⊗⇘P⇙ g) a = (a ⊖ b) ⊗ (to_fun g a)"
using to_fun_mult[of g "X_minus b"] assms X_minus_closed
by (metis P.minus_closed P_def R.nat_pow_closed R.one_closed UP_cring.UP_root_div_closed UP_cring_axioms to_fun_X_minus monom_closed)
show ?thesis
using RHS LHS root factor_theorem' assms(2) assms(3) assms(4)
by auto
qed
end
context UP_cring
begin
definition geometric_series where
"geometric_series n a b = to_fun (UP_root_div (monom P 𝟭 (Suc n) ⊖⇘UP R⇙ (monom P (b[^](Suc n)) 0)) b) a"
lemma geometric_series_id:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "a[^](Suc n) ⊖b[^] (Suc n) = (a ⊖ b) ⊗ (geometric_series n a b)"
using assms geom_quot
by (simp add: P_def geometric_series_def)
lemma geometric_series_closed:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "(geometric_series n a b) ∈ carrier R"
unfolding geometric_series_def
using assms P.minus_closed P_def UP_root_div_closed to_fun_closed monom_closed
by auto
text‹Shows that $a^n - b^n$ has $a - b$ as a factor:›
lemma to_fun_monic_monom_diff:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "∃c. c ∈ carrier R ∧ to_fun (monom P 𝟭 n) a ⊖ to_fun (monom P 𝟭 n) b = (a ⊖ b) ⊗ c"
proof(cases "n = 0")
case True
have "to_fun (monom P 𝟭 0) a ⊖ to_fun (monom P 𝟭 0) b = (a ⊖ b) ⊗ 𝟬"
unfolding a_minus_def using to_fun_const[of 𝟭] assms
by (simp add: R.r_neg)
then show ?thesis
using True by blast
next
case False
then show ?thesis
using Suc_diff_1[of n] geometric_series_id[of a b "n-1"] geometric_series_closed[of a b "n-1"]
assms(1) assms(2) to_fun_monic_monom
by auto
qed
lemma to_fun_diff_factor:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
assumes "f ∈ carrier P"
shows "∃c. c ∈ carrier R ∧(to_fun f a) ⊖ (to_fun f b) = (a ⊖ b)⊗c"
proof(rule poly_induct5[of f])
show "f ∈ carrier P" using assms by simp
show "⋀p q. q ∈ carrier P ⟹
p ∈ carrier P ⟹
∃c. c ∈ carrier R ∧ to_fun p a ⊖ to_fun p b = (a ⊖ b) ⊗ c ⟹
∃c. c ∈ carrier R ∧ to_fun q a ⊖ to_fun q b = (a ⊖ b) ⊗ c ⟹
∃c. c ∈ carrier R ∧ to_fun (p ⊕⇘P⇙ q) a ⊖ to_fun (p ⊕⇘P⇙ q) b = (a ⊖ b) ⊗ c"
proof- fix p q assume A: "q ∈ carrier P" "p ∈ carrier P"
"∃c. c ∈ carrier R ∧ to_fun p a ⊖ to_fun p b = (a ⊖ b) ⊗ c"
"∃c. c ∈ carrier R ∧ to_fun q a ⊖ to_fun q b = (a ⊖ b) ⊗ c"
obtain c where c_def: "c ∈ carrier R ∧ to_fun p a ⊖ to_fun p b = (a ⊖ b) ⊗ c"
using A by blast
obtain c' where c'_def: "c' ∈ carrier R ∧ to_fun q a ⊖ to_fun q b = (a ⊖ b) ⊗ c'"
using A by blast
have 0: "(a ⊖ b) ⊗ c ⊕ (a ⊖ b) ⊗ c' = (a ⊖ b)⊗(c ⊕ c')"
using assms c_def c'_def unfolding a_minus_def
by (simp add: R.r_distr R.r_minus)
have 1: "to_fun (p ⊕⇘P⇙q) a ⊖ to_fun (p ⊕⇘P⇙ q) b = to_fun p a ⊕ to_fun q a ⊖ to_fun p b ⊖ to_fun q b"
using A to_fun_plus[of p q a] to_fun_plus[of p q b] assms to_fun_closed
R.ring_simprules(19)[of "to_fun p b" "to_fun q b"]
by (simp add: R.add.m_assoc R.minus_eq to_fun_plus)
hence "to_fun (p ⊕⇘P⇙q) a ⊖ to_fun (p ⊕⇘P⇙ q) b = to_fun p a ⊖ to_fun p b ⊕ to_fun q a ⊖ to_fun q b"
using 0 A assms R.ring_simprules to_fun_closed a_assoc a_comm
unfolding a_minus_def
by smt
hence "to_fun (p ⊕⇘P⇙q) a ⊖ to_fun (p ⊕⇘P⇙ q) b = to_fun p a ⊖ to_fun p b ⊕ (to_fun q a ⊖ to_fun q b)"
using 0 A assms R.ring_simprules to_fun_closed
unfolding a_minus_def
by metis
hence "to_fun (p ⊕⇘P⇙q) a ⊖ to_fun (p ⊕⇘P⇙ q) b = (a ⊖ b)⊗(c ⊕ c')"
using 0 A c_def c'_def
by simp
thus "∃c. c ∈ carrier R ∧ to_fun (p ⊕⇘P⇙ q) a ⊖ to_fun (p ⊕⇘P⇙ q) b = (a ⊖ b) ⊗ c"
using R.add.m_closed c'_def c_def by blast
qed
show "⋀n. ∃c. c ∈ carrier R ∧ to_fun (monom P 𝟭 n) a ⊖ to_fun (monom P 𝟭 n) b = (a ⊖ b) ⊗ c"
by (simp add: assms(1) assms(2) to_fun_monic_monom_diff)
show "⋀p aa.
aa ∈ carrier R ⟹
p ∈ carrier P ⟹ ∃c. c ∈ carrier R ∧ to_fun p a ⊖ to_fun p b = (a ⊖ b) ⊗ c ⟹ ∃c. c ∈ carrier R ∧ to_fun (aa ⊙⇘P⇙ p) a ⊖ to_fun (aa ⊙⇘P⇙ p) b = (a ⊖ b) ⊗ c"
proof- fix p c assume A: "c ∈ carrier R" " p ∈ carrier P"
"∃e. e ∈ carrier R ∧ to_fun p a ⊖ to_fun p b = (a ⊖ b) ⊗ e"
then obtain d where d_def: "d ∈ carrier R ∧ to_fun p a ⊖ to_fun p b = (a ⊖ b) ⊗ d"
by blast
have "to_fun (c ⊙⇘P⇙ p) a ⊖ to_fun (c ⊙⇘P⇙ p) b = c ⊗ (to_fun p a ⊖ to_fun p b)"
using A d_def assms to_fun_smult[of p a c] to_fun_smult[of p b c]
to_fun_closed[of p a] to_fun_closed[of p b] R.ring_simprules
by smt
hence "c⊗d ∈ carrier R ∧ to_fun (c ⊙⇘P⇙ p) a ⊖ to_fun (c ⊙⇘P⇙ p) b = (a ⊖ b) ⊗ (c ⊗d)"
by (simp add: A(1) R.m_lcomm assms(1) assms(2) d_def)
thus "∃e. e ∈ carrier R ∧ to_fun (c ⊙⇘P⇙ p) a ⊖ to_fun (c ⊙⇘P⇙ p) b = (a ⊖ b) ⊗ e"
by blast
qed
qed
text‹Any finite set over a domain is the zero set of a polynomial:›
lemma(in UP_domain) fin_set_poly_roots:
assumes "F ⊆ carrier R"
assumes "finite F"
shows "∃ P ∈ carrier (UP R). ∀ x ∈ carrier R. to_fun P x = 𝟬 ⟷ x ∈ F"
apply(rule finite.induct)
apply (simp add: assms(2))
proof-
show "∃P∈carrier (UP R). ∀x∈carrier R. (to_fun P x = 𝟬) = (x ∈ {})"
proof-
have "∀x∈carrier R. (to_fun (𝟭⇘UP R⇙) x = 𝟬) = (x ∈ {})"
proof
fix x
assume A: "x ∈ carrier R"
then have "(to_fun (𝟭⇘UP R⇙)) x = 𝟭"
by (metis P_def R.one_closed UP_cring.to_fun_to_poly UP_cring_axioms ring_hom_one to_poly_is_ring_hom)
then show "(to_fun 𝟭⇘UP R⇙ x = 𝟬) = (x ∈ {})"
by simp
qed
then show ?thesis
using P_def UP_one_closed
by blast
qed
show "⋀A a. finite A ⟹
∃P∈carrier (UP R). ∀x∈carrier R. (to_fun P x = 𝟬) = (x ∈ A) ⟹ ∃P∈carrier (UP R). ∀x∈carrier R. (to_fun P x = 𝟬) = (x ∈ insert a A)"
proof-
fix A :: "'a set" fix a
assume fin_A: "finite A"
assume IH: "∃P∈carrier (UP R). ∀x∈carrier R. (to_fun P x = 𝟬) = (x ∈ A)"
then obtain p where p_def: "p ∈carrier (UP R) ∧ (∀x∈carrier R. (to_fun p x = 𝟬) = (x ∈ A))"
by blast
show "∃P∈carrier (UP R). ∀x∈carrier R. (to_fun P x = 𝟬) = (x ∈ insert a A)"
proof(cases "a ∈ carrier R")
case True
obtain Q where Q_def: "Q = p ⊗⇘UP R⇙ (X ⊖⇘UP R⇙ to_poly a)"
by blast
have "∀x∈carrier R. (to_fun Q x = 𝟬) = (x ∈ insert a A)"
proof fix x
assume P: "x ∈ carrier R"
have P0: "to_fun (X ⊖⇘UP R⇙ to_poly a) x = x ⊖ a"
using to_fun_plus[of X "⊖⇘UP R⇙ to_poly a" x] True P
unfolding a_minus_def
by (metis X_poly_minus_def a_minus_def to_fun_X_minus)
then have "to_fun Q x = (to_fun p x) ⊗ (x ⊖ a)"
proof-
have 0: " p ∈ carrier P"
by (simp add: P_def p_def)
have 1: " X ⊖⇘UP R⇙ to_poly a ∈ carrier P"
using P.minus_closed P_def True X_closed to_poly_closed by auto
have 2: "x ∈ carrier R"
by (simp add: P)
then show ?thesis
using to_fun_mult[of p "(X ⊖⇘UP R⇙ to_poly a)" x] P0 0 1 2 Q_def True P_def to_fun_mult
by auto
qed
then show "(to_fun Q x = 𝟬) = (x ∈ insert a A)"
using p_def
by (metis P R.add.inv_closed R.integral_iff R.l_neg R.minus_closed R.minus_unique True UP_cring.to_fun_closed UP_cring_axioms a_minus_def insert_iff)
qed
then have "Q ∈ carrier (UP R) ∧ (∀x∈carrier R. (to_fun Q x = 𝟬) = (x ∈ insert a A))"
using P.minus_closed P_def Q_def True UP_mult_closed X_closed p_def to_poly_closed by auto
then show ?thesis
by blast
next
case False
then show ?thesis
using IH subsetD by auto
qed
qed
qed
subsection‹Polynomial Evaluation at Multiplicative Inverses›
text‹For every polynomial $p(x)$ of degree $n$, there is a unique polynomial $q(x)$ which satisfies the equation $q(x) = x^n p(1/x)$. This section defines this polynomial and proves this identity.›
definition(in UP_cring) one_over_poly where
"one_over_poly p = (λ n. if n ≤ degree p then p ((degree p) - n) else 𝟬)"
lemma(in UP_cring) one_over_poly_closed:
assumes "p ∈ carrier P"
shows "one_over_poly p ∈ carrier P"
apply(rule UP_car_memI[of "degree p" ])
unfolding one_over_poly_def using assms apply simp
by (simp add: assms cfs_closed)
lemma(in UP_cring) one_over_poly_monom:
assumes "a ∈ carrier R"
shows "one_over_poly (monom P a n) = monom P a 0"
apply(rule ext)
unfolding one_over_poly_def using assms
by (metis cfs_monom deg_monom diff_diff_cancel diff_is_0_eq diff_self_eq_0 zero_diff)
lemma(in UP_cring) one_over_poly_monom_add:
assumes "a ∈ carrier R"
assumes "a ≠ 𝟬"
assumes "p ∈ carrier P"
assumes "degree p < n"
shows "one_over_poly (p ⊕⇘P⇙ monom P a n) = monom P a 0 ⊕⇘P⇙ monom P 𝟭 (n - degree p) ⊗⇘P⇙ one_over_poly p"
proof-
have 0: "degree (p ⊕⇘P⇙ monom P a n) = n"
by (simp add: assms(1) assms(2) assms(3) assms(4) equal_deg_sum)
show ?thesis
proof(rule ext) fix x show "one_over_poly (p ⊕⇘P⇙ monom P a n) x =
(monom P a 0 ⊕⇘P⇙ monom P 𝟭 (n - deg R p) ⊗⇘P⇙ one_over_poly p) x"
proof(cases "x = 0")
case T: True
have T0: "one_over_poly (p ⊕⇘P⇙ monom P a n) 0 = a"
unfolding one_over_poly_def
by (metis lcf_eq lcf_monom(1) ltrm_of_sum_diff_deg P.add.m_closed assms(1) assms(2) assms(3) assms(4) diff_zero le0 monom_closed)
have T1: "(monom P a 0 ⊕⇘P⇙ monom P 𝟭 (n - degree p) ⊗⇘P⇙ one_over_poly p) 0 = a"
using one_over_poly_closed
by (metis (no_types, lifting) lcf_monom(1) R.one_closed R.r_zero UP_m_comm UP_mult_closed assms(1) assms(3) assms(4) cfs_add cfs_monom_mult deg_const monom_closed zero_less_diff)
show ?thesis using T0 T1 T by auto
next
case F: False
show ?thesis
proof(cases "x < n - degree p")
case True
then have T0: "degree p < n - x ∧ n - x < n"
using F by auto
then have T1: "one_over_poly (p ⊕⇘P⇙ monom P a n) x = 𝟬"
using True F 0 unfolding one_over_poly_def
using assms(1) assms(3) coeff_of_sum_diff_degree0
by (metis ltrm_cfs ltrm_of_sum_diff_deg P.add.m_closed P.add.m_comm assms(2) assms(4) monom_closed nat_neq_iff)
have "(monom P a 0 ⊕⇘P⇙ monom P 𝟭 (n - degree p) ⊗⇘P⇙ one_over_poly p) x = 𝟬"
using True F 0 one_over_poly_def one_over_poly_closed
by (metis (no_types, lifting) P.add.m_comm P.m_closed R.one_closed UP_m_comm assms(1)
assms(3) cfs_monom_mult coeff_of_sum_diff_degree0 deg_const monom_closed neq0_conv)
then show ?thesis using T1 by auto
next
case False
then have "n - degree p ≤ x"
by auto
then obtain k where k_def: "k + (n - degree p) = x"
using le_Suc_ex diff_add
by blast
have F0: "(monom P a 0 ⊕⇘P⇙ monom P 𝟭 (n - deg R p) ⊗⇘P⇙ one_over_poly p) x
= one_over_poly p k"
using k_def one_over_poly_closed assms
times_X_pow_coeff[of "one_over_poly p" "n - deg R p" k]
P.m_closed
by (metis (no_types, lifting) P.add.m_comm R.one_closed add_gr_0 coeff_of_sum_diff_degree0 deg_const monom_closed zero_less_diff)
show ?thesis
proof(cases "x ≤ n")
case True
have T0: "n - x = degree p - k"
using assms(4) k_def by linarith
have T1: "n - x < n"
using True F
by linarith
then have F1: "(p ⊕⇘P⇙ monom P a n) (n - x) = p (degree p - k)"
using True False F0 0 k_def cfs_add
by (simp add: F0 T0 assms(1) assms(3) cfs_closed cfs_monom)
then show ?thesis
using "0" F0 assms(1) assms(2) assms(3) degree_of_sum_diff_degree k_def one_over_poly_def
by auto
next
case False
then show ?thesis
using "0" F0 assms(1) assms(2) assms(3) degree_of_sum_diff_degree k_def one_over_poly_def
by auto
qed
qed
qed
qed
qed
lemma( in UP_cring) one_over_poly_eval:
assumes "p ∈ carrier P"
assumes "x ∈ carrier R"
assumes "x ∈ Units R"
shows "to_fun (one_over_poly p) x = (x[^](degree p)) ⊗ (to_fun p (inv⇘R⇙ x))"
proof(rule poly_induct6[of p])
show " p ∈ carrier P"
using assms by simp
show "⋀a n. a ∈ carrier R ⟹
to_fun (one_over_poly (monom P a 0)) x = x [^] deg R (monom P a 0) ⊗ to_fun (monom P a 0) (inv x)"
using assms to_fun_const one_over_poly_monom by auto
show "⋀a n p.
a ∈ carrier R ⟹
a ≠ 𝟬 ⟹
p ∈ carrier P ⟹
deg R p < n ⟹
to_fun (one_over_poly p) x = x [^] deg R p ⊗ to_fun p (inv x) ⟹
to_fun (one_over_poly (p ⊕⇘P⇙ monom P a n)) x = x [^] deg R (p ⊕⇘P⇙ monom P a n) ⊗ to_fun (p ⊕⇘P⇙ monom P a n) (inv x)"
proof- fix a n p assume A: "a ∈ carrier R" "a ≠ 𝟬" "p ∈ carrier P" "deg R p < n"
"to_fun (one_over_poly p) x = x [^] deg R p ⊗ to_fun p (inv x)"
have "one_over_poly (p ⊕⇘P⇙ monom P a n) = monom P a 0 ⊕⇘P⇙ monom P 𝟭 (n - degree p) ⊗⇘P⇙ one_over_poly p"
using A by (simp add: one_over_poly_monom_add)
hence "to_fun ( one_over_poly (p ⊕⇘P⇙ monom P a n)) x =
a ⊕ to_fun ( monom P 𝟭 (n - degree p) ⊗⇘P⇙ one_over_poly p) x"
using A to_fun_plus one_over_poly_closed cfs_add
by (simp add: assms(2) to_fun_const)
hence "to_fun (one_over_poly (p ⊕⇘P⇙ monom P a n)) x = a ⊕ x[^](n - degree p) ⊗ x [^] degree p ⊗ to_fun p (inv x)"
by (simp add: A(3) A(5) R.m_assoc assms(2) assms(3) to_fun_closed to_fun_monic_monom to_fun_mult one_over_poly_closed)
hence 0:"to_fun (one_over_poly (p ⊕⇘P⇙ monom P a n)) x = a ⊕ x[^]n ⊗ to_fun p (inv x)"
using A R.nat_pow_mult assms(2)
by auto
have 1: "to_fun (one_over_poly (p ⊕⇘P⇙ monom P a n)) x = x[^]n ⊗ (a ⊗ inv x [^]n ⊕ to_fun p (inv x))"
proof-
have "x[^]n ⊗ a ⊗ inv x [^]n = a"
by (metis (no_types, hide_lams) A(1) R.Units_inv_closed R.Units_r_inv R.m_assoc
R.m_comm R.nat_pow_closed R.nat_pow_distrib R.nat_pow_one R.r_one assms(2) assms(3))
thus ?thesis
using A R.ring_simprules(23)[of _ _ "x[^]n"] 0 R.m_assoc assms(2) assms(3) to_fun_closed
by auto
qed
have 2: "degree (p ⊕⇘P⇙ monom P a n) = n"
by (simp add: A(1) A(2) A(3) A(4) equal_deg_sum)
show " to_fun (one_over_poly (p ⊕⇘P⇙ monom P a n)) x = x [^] deg R (p ⊕⇘P⇙ monom P a n) ⊗ to_fun (p ⊕⇘P⇙ monom P a n) (inv x)"
using 1 2
by (metis (no_types, lifting) A(1) A(3) P_def R.Units_inv_closed R.add.m_comm
UP_cring.to_fun_monom UP_cring_axioms assms(3) to_fun_closed to_fun_plus monom_closed)
qed
qed
end
section‹Lifting Homomorphisms of Rings to Polynomial Rings by Application to Coefficients›
definition poly_lift_hom where
"poly_lift_hom R S φ = eval R (UP S) (to_polynomial S ∘ φ) (X_poly S)"
context UP_ring
begin
lemma(in UP_cring) pre_poly_lift_hom_is_hom:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
shows "ring_hom_ring R (UP S) (to_polynomial S ∘ φ)"
apply(rule ring_hom_ringI)
apply (simp add: R.ring_axioms)
apply (simp add: UP_ring.UP_ring UP_ring.intro assms(1) cring.axioms(1))
using UP_cring.intro UP_cring.to_poly_closed assms(1) assms(2) ring_hom_closed apply fastforce
using assms UP_cring.to_poly_closed[of S] ring_hom_closed[of φ R S] comp_apply[of "to_polynomial S" φ]
unfolding UP_cring_def
apply (metis UP_cring.to_poly_mult UP_cring_def ring_hom_mult)
using assms UP_cring.to_poly_closed[of S] ring_hom_closed[of φ R S] comp_apply[of "to_polynomial S" φ]
unfolding UP_cring_def
apply (metis UP_cring.to_poly_add UP_cring_def ring_hom_add)
using assms UP_cring.to_poly_closed[of S] ring_hom_one[of φ R S] comp_apply[of "to_polynomial S" φ]
unfolding UP_cring_def
by (simp add: ‹φ ∈ ring_hom R S ⟹ φ 𝟭 = 𝟭⇘S⇙› UP_cring.intro UP_cring.to_poly_is_ring_hom ring_hom_one)
lemma(in UP_cring) poly_lift_hom_is_hom:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
shows "poly_lift_hom R S φ ∈ ring_hom (UP R) (UP S)"
unfolding poly_lift_hom_def
apply( rule UP_pre_univ_prop.eval_ring_hom[of R "UP S" ])
unfolding UP_pre_univ_prop_def
apply (simp add: R_cring RingHom.ring_hom_cringI UP_cring.UP_cring UP_cring_def assms(1) assms(2) pre_poly_lift_hom_is_hom)
by (simp add: UP_cring.X_closed UP_cring.intro assms(1))
lemma(in UP_cring) poly_lift_hom_closed:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "p ∈ carrier (UP R)"
shows "poly_lift_hom R S φ p ∈ carrier (UP S)"
by (metis assms(1) assms(2) assms(3) poly_lift_hom_is_hom ring_hom_closed)
lemma(in UP_cring) poly_lift_hom_add:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "p ∈ carrier (UP R)"
assumes "q ∈ carrier (UP R)"
shows "poly_lift_hom R S φ (p ⊕⇘UP R⇙ q) = poly_lift_hom R S φ p ⊕⇘UP S⇙ poly_lift_hom R S φ q"
using assms poly_lift_hom_is_hom[of S φ] ring_hom_add[of "poly_lift_hom R S φ" "UP R" "UP S" p q]
by blast
lemma(in UP_cring) poly_lift_hom_mult:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "p ∈ carrier (UP R)"
assumes "q ∈ carrier (UP R)"
shows "poly_lift_hom R S φ (p ⊗⇘UP R⇙ q) = poly_lift_hom R S φ p ⊗⇘UP S⇙ poly_lift_hom R S φ q"
using assms poly_lift_hom_is_hom[of S φ] ring_hom_mult[of "poly_lift_hom R S φ" "UP R" "UP S" p q]
by blast
lemma(in UP_cring) poly_lift_hom_extends_hom:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "r ∈ carrier R"
shows "poly_lift_hom R S φ (to_polynomial R r) = to_polynomial S (φ r)"
using UP_pre_univ_prop.eval_const[of R "UP S" "to_polynomial S ∘ φ" "X_poly S" r ] assms
comp_apply[of "λa. monom (UP S) a 0" φ r] pre_poly_lift_hom_is_hom[of S φ]
unfolding poly_lift_hom_def to_polynomial_def UP_pre_univ_prop_def
by (simp add: R_cring RingHom.ring_hom_cringI UP_cring.UP_cring UP_cring.X_closed UP_cring.intro)
lemma(in UP_cring) poly_lift_hom_extends_hom':
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "r ∈ carrier R"
shows "poly_lift_hom R S φ (monom P r 0) = monom (UP S) (φ r) 0"
using poly_lift_hom_extends_hom[of S φ r] assms
unfolding to_polynomial_def P_def
by blast
lemma(in UP_cring) poly_lift_hom_smult:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "p ∈ carrier (UP R)"
assumes "a ∈ carrier R"
shows "poly_lift_hom R S φ (a ⊙⇘UP R⇙ p) = φ a ⊙⇘UP S⇙ (poly_lift_hom R S φ p)"
using assms poly_lift_hom_is_hom[of S φ] poly_lift_hom_extends_hom'[of S φ a]
poly_lift_hom_mult[of S φ "monom P a 0" p] ring_hom_closed[of φ R S a]
UP_ring.monom_mult_is_smult[of S "φ a" "poly_lift_hom R S φ p"]
monom_mult_is_smult[of a p] monom_closed[of a 0] poly_lift_hom_closed[of S φ p]
unfolding to_polynomial_def UP_ring_def P_def cring_def
by simp
lemma(in UP_cring) poly_lift_hom_monom:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "r ∈ carrier R"
shows "poly_lift_hom R S φ (monom (UP R) r n) = (monom (UP S) (φ r) n)"
proof-
have "eval R (UP S) (to_polynomial S ∘ φ) (X_poly S) (monom (UP R) r n) = (to_polynomial S ∘ φ) r ⊗⇘UP S⇙ X_poly S [^]⇘UP S⇙ n"
using assms UP_pre_univ_prop.eval_monom[of R "UP S" "to_polynomial S ∘ φ" r "X_poly S" n]
unfolding UP_pre_univ_prop_def UP_cring_def ring_hom_cring_def
by (meson UP_cring.UP_cring UP_cring.X_closed UP_cring.pre_poly_lift_hom_is_hom UP_cring_axioms
UP_cring_def ring_hom_cring_axioms.intro ring_hom_ring.homh)
then have "eval R (UP S) (to_polynomial S ∘ φ) (X_poly S) (monom (UP R) r n) = (to_polynomial S (φ r)) ⊗⇘UP S⇙ X_poly S [^]⇘UP S⇙ n"
by simp
then show ?thesis
unfolding poly_lift_hom_def
using assms UP_cring.monom_rep_X_pow[of S "φ r" n] ring_hom_closed[of φ R S r]
by (metis UP_cring.X_closed UP_cring.intro UP_cring.monom_sub UP_cring.sub_monom(1))
qed
lemma(in UP_cring) poly_lift_hom_X_var:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
shows "poly_lift_hom R S φ (monom (UP R) 𝟭⇘R⇙ 1) = (monom (UP S) 𝟭⇘S⇙ 1)"
using assms(1) assms(2) poly_lift_hom_monom ring_hom_one by fastforce
lemma(in UP_cring) poly_lift_hom_X_var':
assumes "cring S"
assumes "φ ∈ ring_hom R S"
shows "poly_lift_hom R S φ (X_poly R) = (X_poly S)"
unfolding X_poly_def
using assms(1) assms(2) poly_lift_hom_X_var by blast
lemma(in UP_cring) poly_lift_hom_X_var'':
assumes "cring S"
assumes "φ ∈ ring_hom R S"
shows "poly_lift_hom R S φ (monom (UP R) 𝟭⇘R⇙ n) = (monom (UP S) 𝟭⇘S⇙ n)"
using assms(1) assms(2) poly_lift_hom_monom ring_hom_one by fastforce
lemma(in UP_cring) poly_lift_hom_X_var''':
assumes "cring S"
assumes "φ ∈ ring_hom R S"
shows "poly_lift_hom R S φ (X_poly R [^]⇘UP R⇙ (n::nat)) = (X_poly S) [^]⇘UP S⇙ (n::nat)"
using assms
by (smt ltrm_of_X P.nat_pow_closed P_def R.ring_axioms UP_cring.to_fun_closed UP_cring.intro
UP_cring.monom_pow UP_cring.poly_lift_hom_monom UP_cring_axioms X_closed cfs_closed
cring.axioms(1) to_fun_X_pow poly_lift_hom_X_var' ring_hom_closed ring_hom_nat_pow)
lemma(in UP_cring) poly_lift_hom_X_plus:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "a ∈ carrier R"
shows "poly_lift_hom R S φ (X_poly_plus R a) = X_poly_plus S (φ a)"
using ring_hom_add
unfolding X_poly_plus_def
using P_def X_closed assms(1) assms(2) assms(3) poly_lift_hom_X_var' poly_lift_hom_add poly_lift_hom_extends_hom to_poly_closed by fastforce
lemma(in UP_cring) poly_lift_hom_X_plus_nat_pow:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "a ∈ carrier R"
shows "poly_lift_hom R S φ (X_poly_plus R a [^]⇘UP R⇙ (n::nat)) = X_poly_plus S (φ a) [^]⇘UP S⇙ (n::nat)"
using assms poly_lift_hom_X_plus[of S φ a]
ring_hom_nat_pow[of "UP R" "UP S" "poly_lift_hom R S φ" "X_poly_plus R a" n]
poly_lift_hom_is_hom[of S φ] X_plus_closed[of a] UP_ring.UP_ring[of S]
unfolding P_def cring_def UP_cring_def
using P_def UP_ring UP_ring.intro
by (simp add: UP_ring.intro)
lemma(in UP_cring) X_poly_plus_nat_pow_closed:
assumes "a ∈ carrier R"
shows " X_poly_plus R a [^]⇘UP R⇙ (n::nat) ∈ carrier (UP R)"
using assms P.nat_pow_closed P_def X_plus_closed by auto
lemma(in UP_cring) poly_lift_hom_X_plus_nat_pow_smult:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "poly_lift_hom R S φ (b ⊙⇘UP R⇙ X_poly_plus R a [^]⇘UP R⇙ (n::nat)) = φ b ⊙⇘UP S ⇙X_poly_plus S (φ a) [^]⇘UP S⇙ (n::nat)"
by (simp add: X_poly_plus_nat_pow_closed assms(1) assms(2) assms(3) assms(4) poly_lift_hom_X_plus_nat_pow poly_lift_hom_smult)
lemma(in UP_cring) poly_lift_hom_X_minus:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "a ∈ carrier R"
shows "poly_lift_hom R S φ (X_poly_minus R a) = X_poly_minus S (φ a)"
using poly_lift_hom_X_plus[of S φ "⊖ a"] X_minus_plus[of a] UP_cring.X_minus_plus[of S "φ a"]
R.ring_hom_a_inv[of S φ a]
unfolding UP_cring_def P_def
by (metis R.add.inv_closed assms(1) assms(2) assms(3) cring.axioms(1) ring_hom_closed)
lemma(in UP_cring) poly_lift_hom_X_minus_nat_pow:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "a ∈ carrier R"
shows "poly_lift_hom R S φ (X_poly_minus R a [^]⇘UP R⇙ (n::nat)) = X_poly_minus S (φ a) [^]⇘UP S⇙ (n::nat)"
using assms poly_lift_hom_X_minus ring_hom_nat_pow X_minus_plus UP_cring.X_minus_plus
poly_lift_hom_X_plus poly_lift_hom_X_plus_nat_pow by fastforce
lemma(in UP_cring) X_poly_minus_nat_pow_closed:
assumes "a ∈ carrier R"
shows "X_poly_minus R a [^]⇘UP R⇙ (n::nat) ∈ carrier (UP R)"
using assms monoid.nat_pow_closed[of "UP R" "X_poly_minus R a" n]
P.nat_pow_closed P_def X_minus_closed by auto
lemma(in UP_cring) poly_lift_hom_X_minus_nat_pow_smult:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "poly_lift_hom R S φ (b ⊙⇘UP R⇙ X_poly_minus R a [^]⇘UP R⇙ (n::nat)) = φ b ⊙⇘UP S ⇙X_poly_minus S (φ a) [^]⇘UP S⇙ (n::nat)"
by (simp add: X_poly_minus_nat_pow_closed assms(1) assms(2) assms(3) assms(4) poly_lift_hom_X_minus_nat_pow poly_lift_hom_smult)
lemma(in UP_cring) poly_lift_hom_cf:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "p ∈ carrier P"
shows "poly_lift_hom R S φ p k = φ (p k)"
apply(rule poly_induct3[of p])
apply (simp add: assms(3))
proof-
show "⋀p q. q ∈ carrier P ⟹
p ∈ carrier P ⟹
poly_lift_hom R S φ p k = φ (p k) ⟹ poly_lift_hom R S φ q k = φ (q k) ⟹ poly_lift_hom R S φ (p ⊕⇘P⇙ q) k = φ ((p ⊕⇘P⇙ q) k)"
proof- fix p q assume A: "p ∈ carrier P" "q ∈ carrier P"
"poly_lift_hom R S φ p k = φ (p k)" "poly_lift_hom R S φ q k = φ (q k)"
show "poly_lift_hom R S φ q k = φ (q k) ⟹ poly_lift_hom R S φ (p ⊕⇘P⇙ q) k = φ ((p ⊕⇘P⇙ q) k)"
using A assms poly_lift_hom_add[of S φ p q]
poly_lift_hom_closed[of S φ p] poly_lift_hom_closed[of S φ q]
UP_ring.cfs_closed[of S "poly_lift_hom R S φ q " k] UP_ring.cfs_closed[of S "poly_lift_hom R S φ p" k]
UP_ring.cfs_add[of S "poly_lift_hom R S φ p" "poly_lift_hom R S φ q" k]
unfolding P_def UP_ring_def
by (metis (full_types) P_def cfs_add cfs_closed cring.axioms(1) ring_hom_add)
qed
show "⋀a n. a ∈ carrier R ⟹ poly_lift_hom R S φ (monom P a n) k = φ (monom P a n k)"
proof- fix a m assume A: "a ∈ carrier R"
show "poly_lift_hom R S φ (monom P a m) k = φ (monom P a m k)"
apply(cases "m = k")
using cfs_monom[of a m k] assms poly_lift_hom_monom[of S φ a m] UP_ring.cfs_monom[of S "φ a" m k]
unfolding P_def UP_ring_def
apply (simp add: A cring.axioms(1) ring_hom_closed)
using cfs_monom[of a m k] assms poly_lift_hom_monom[of S φ a m] UP_ring.cfs_monom[of S "φ a" m k]
unfolding P_def UP_ring_def
by (metis A P_def R.ring_axioms cring.axioms(1) ring_hom_closed ring_hom_zero)
qed
qed
lemma(in ring) ring_hom_monom_term:
assumes "a ∈ carrier R"
assumes "c ∈ carrier R"
assumes "ring S"
assumes "h ∈ ring_hom R S"
shows "h (a ⊗ c[^](n::nat)) = h a ⊗⇘S⇙ (h c)[^]⇘S⇙n"
apply(induction n)
using assms ringE(2) ring_hom_closed apply fastforce
by (metis assms(1) assms(2) assms(3) assms(4) local.ring_axioms nat_pow_closed ring_hom_mult ring_hom_nat_pow)
lemma(in UP_cring) poly_lift_hom_eval:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
shows "UP_cring.to_fun S (poly_lift_hom R S φ p) (φ a) = φ (to_fun p a) "
apply(rule poly_induct3[of p])
apply (simp add: assms(3))
proof-
show "⋀p q. q ∈ carrier P ⟹
p ∈ carrier P ⟹
UP_cring.to_fun S (poly_lift_hom R S φ p) (φ a) = φ (to_fun p a) ⟹
UP_cring.to_fun S (poly_lift_hom R S φ q) (φ a) = φ (to_fun q a) ⟹
UP_cring.to_fun S (poly_lift_hom R S φ (p ⊕⇘P⇙ q)) (φ a) = φ (to_fun (p ⊕⇘P⇙ q) a)"
proof- fix p q assume A: "q ∈ carrier P" "p ∈ carrier P"
"UP_cring.to_fun S (poly_lift_hom R S φ p) (φ a) = φ (to_fun p a)"
"UP_cring.to_fun S (poly_lift_hom R S φ q) (φ a) = φ (to_fun q a)"
have "(poly_lift_hom R S φ (p ⊕⇘P⇙ q)) = poly_lift_hom R S φ p ⊕⇘UP S⇙ poly_lift_hom R S φ q"
using A(1) A(2) P_def assms(1) assms(2) poly_lift_hom_add by auto
hence "UP_cring.to_fun S (poly_lift_hom R S φ (p ⊕⇘P⇙ q)) (φ a) =
UP_cring.to_fun S (poly_lift_hom R S φ p) (φ a) ⊕⇘S⇙ UP_cring.to_fun S (poly_lift_hom R S φ q) (φ a)"
using UP_cring.to_fun_plus[of S] assms
unfolding UP_cring_def
by (metis (no_types, lifting) A(1) A(2) P_def poly_lift_hom_closed ring_hom_closed)
thus "UP_cring.to_fun S (poly_lift_hom R S φ (p ⊕⇘P⇙ q)) (φ a) = φ (to_fun (p ⊕⇘P⇙ q) a)"
using A to_fun_plus assms ring_hom_add[of φ R S]
poly_lift_hom_closed[of S φ] UP_cring.to_fun_def[of S] to_fun_def
unfolding P_def UP_cring_def
using UP_cring.to_fun_closed UP_cring_axioms
by metis
qed
show "⋀c n. c ∈ carrier R ⟹ UP_cring.to_fun S (poly_lift_hom R S φ (monom P c n)) (φ a) = φ (to_fun (monom P c n) a)"
unfolding P_def
proof - fix c n assume A: "c ∈ carrier R"
have 0: "φ (a [^]⇘R⇙ (n::nat)) = φ a [^]⇘S⇙ n"
using assms ring_hom_nat_pow[of R S φ a n]
unfolding cring_def
using R.ring_axioms by blast
have 1: "φ (c ⊗⇘R⇙ a [^]⇘R⇙ n) = φ c ⊗⇘S⇙ φ a [^]⇘S⇙ n"
using ring_hom_mult[of φ R S c "a [^]⇘R⇙ n" ] 0 assms A monoid.nat_pow_closed [of R a n]
by (simp add: cring.axioms(1) ringE(2))
show "UP_cring.to_fun S (poly_lift_hom R S φ (monom (UP R) c n)) (φ a) = φ (to_fun(monom (UP R) c n) a)"
using assms A poly_lift_hom_monom[of S φ c n] UP_cring.to_fun_monom[of S "φ c" "φ a" n]
to_fun_monom[of c a n] 0 1 ring_hom_closed[of φ R S] unfolding UP_cring_def
by (simp add: P_def to_fun_def)
qed
qed
lemma(in UP_cring) poly_lift_hom_sub:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "p ∈ carrier P"
assumes "q ∈ carrier P"
shows "poly_lift_hom R S φ (compose R p q) = compose S (poly_lift_hom R S φ p) (poly_lift_hom R S φ q)"
apply(rule poly_induct3[of p])
apply (simp add: assms(3))
proof-
show " ⋀p qa.
qa ∈ carrier P ⟹
p ∈ carrier P ⟹
poly_lift_hom R S φ (Cring_Poly.compose R p q) = Cring_Poly.compose S (poly_lift_hom R S φ p) (poly_lift_hom R S φ q) ⟹
poly_lift_hom R S φ (Cring_Poly.compose R qa q) = Cring_Poly.compose S (poly_lift_hom R S φ qa) (poly_lift_hom R S φ q) ⟹
poly_lift_hom R S φ (Cring_Poly.compose R (p ⊕⇘P⇙ qa) q) = Cring_Poly.compose S (poly_lift_hom R S φ (p ⊕⇘P⇙ qa)) (poly_lift_hom R S φ q)"
proof- fix a b assume A: "a ∈ carrier P"
"b ∈ carrier P"
"poly_lift_hom R S φ (Cring_Poly.compose R a q) = Cring_Poly.compose S (poly_lift_hom R S φ a) (poly_lift_hom R S φ q)"
"poly_lift_hom R S φ (Cring_Poly.compose R b q) = Cring_Poly.compose S (poly_lift_hom R S φ b) (poly_lift_hom R S φ q)"
show "poly_lift_hom R S φ (Cring_Poly.compose R (a ⊕⇘P⇙ b) q) = Cring_Poly.compose S (poly_lift_hom R S φ (a ⊕⇘P⇙ b)) (poly_lift_hom R S φ q)"
using assms UP_cring.sub_add[of R q a b ] UP_cring.sub_add[of S ]
unfolding UP_cring_def
by (metis A(1) A(2) A(3) A(4) P_def R_cring UP_cring.sub_closed UP_cring_axioms poly_lift_hom_add poly_lift_hom_closed)
qed
show "⋀a n. a ∈ carrier R ⟹
poly_lift_hom R S φ (Cring_Poly.compose R (monom P a n) q) =
Cring_Poly.compose S (poly_lift_hom R S φ (monom P a n)) (poly_lift_hom R S φ q)"
proof-
fix a n assume A: "a ∈ carrier R"
have 0: "(poly_lift_hom R S φ (monom (UP R) a n)) = monom (UP S) (φ a) n"
by (simp add: A assms(1) assms(2) assms(3) assms(4) poly_lift_hom_monom)
have 1: " q [^]⇘UP R⇙ n ∈ carrier (UP R)"
using monoid.nat_pow_closed[of "UP R" q n] UP_ring.UP_ring UP_ring.intro assms(1) assms
P.monoid_axioms P_def by blast
have 2: "poly_lift_hom R S φ (to_polynomial R a ⊗⇘UP R⇙ q [^]⇘UP R⇙ n) =
to_polynomial S (φ a) ⊗⇘UP S⇙ (poly_lift_hom R S φ q) [^]⇘UP S⇙ n"
using poly_lift_hom_mult[of S φ "to_polynomial R a" "q [^]⇘UP R⇙ n"] poly_lift_hom_is_hom[of S φ]
ring_hom_nat_pow[of P "UP S" "poly_lift_hom R S φ" q n] UP_cring.UP_cring[of S]
UP_cring poly_lift_hom_monom[of S φ a 0] ring_hom_closed[of φ R S a]
monom_closed[of a 0] nat_pow_closed[of q n] assms A
unfolding to_polynomial_def P_def UP_cring_def cring_def
by auto
have 3: "poly_lift_hom R S φ (Cring_Poly.compose R (monom (UP R) a n) q) = to_polynomial S (φ a) ⊗⇘UP S⇙ (poly_lift_hom R S φ q) [^]⇘UP S⇙ n"
using "2" A P_def assms(4) sub_monom(1) by auto
have 4: "Cring_Poly.compose S (poly_lift_hom R S φ (monom (UP R) a n)) (poly_lift_hom R S φ q)
= Cring_Poly.compose S (monom (UP S) (φ a) n) (poly_lift_hom R S φ q)"
by (simp add: "0")
have "poly_lift_hom R S φ q ∈ carrier (UP S)"
using P_def UP_cring.poly_lift_hom_closed UP_cring_axioms assms(1) assms(2) assms(4) by blast
then have 5: "Cring_Poly.compose S (poly_lift_hom R S φ (monom (UP R) a n)) (poly_lift_hom R S φ q)
= to_polynomial S (φ a) ⊗⇘UP S⇙ (poly_lift_hom R S φ q) [^]⇘UP S⇙ n"
using 4 UP_cring.sub_monom[of S "poly_lift_hom R S φ q" "φ a" n] assms
unfolding UP_cring_def
by (simp add: A ring_hom_closed)
thus "poly_lift_hom R S φ (Cring_Poly.compose R (monom P a n) q) =
Cring_Poly.compose S (poly_lift_hom R S φ (monom P a n)) (poly_lift_hom R S φ q)"
using 0 1 2 3 4 assms A
by (simp add: P_def)
qed
qed
lemma(in UP_cring) poly_lift_hom_comm_taylor_expansion:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
shows "poly_lift_hom R S φ (taylor_expansion R a p) = taylor_expansion S (φ a) (poly_lift_hom R S φ p)"
unfolding taylor_expansion_def
using poly_lift_hom_sub[of S φ p "(X_poly_plus R a)"] poly_lift_hom_X_plus[of S φ a] assms
by (simp add: P_def UP_cring.X_plus_closed UP_cring_axioms)
lemma(in UP_cring) poly_lift_hom_comm_taylor_expansion_cf:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "p ∈ carrier (UP R)"
assumes "a ∈ carrier R"
shows "φ (taylor_expansion R a p i) = taylor_expansion S (φ a) (poly_lift_hom R S φ p) i"
using poly_lift_hom_cf assms poly_lift_hom_comm_taylor_expansion P_def
taylor_def UP_cring.taylor_closed UP_cring_axioms by fastforce
lemma(in UP_cring) taylor_expansion_cf_closed:
assumes "p ∈ carrier P"
assumes "a ∈ carrier R"
shows "taylor_expansion R a p i ∈ carrier R"
using assms taylor_closed
by (simp add: taylor_def cfs_closed)
lemma(in UP_cring) poly_lift_hom_comm_taylor_term:
assumes "cring S"
assumes "φ ∈ ring_hom R S"
assumes "p ∈ carrier (UP R)"
assumes "a ∈ carrier R"
shows "poly_lift_hom R S φ (taylor_term a p i) = UP_cring.taylor_term S (φ a) (poly_lift_hom R S φ p) i"
using poly_lift_hom_X_minus_nat_pow_smult[of S φ a "taylor_expansion R a p i" i]
poly_lift_hom_comm_taylor_expansion[of S φ p a]
poly_lift_hom_comm_taylor_expansion_cf[of S φ p a i]
assms UP_cring.taylor_term_def[of S]
unfolding taylor_term_def UP_cring_def P_def
by (simp add: UP_cring.taylor_expansion_cf_closed UP_cring_axioms)
lemma(in UP_cring) poly_lift_hom_degree_bound:
assumes "cring S"
assumes "h ∈ ring_hom R S"
assumes "f ∈ carrier (UP R)"
shows "deg S (poly_lift_hom R S h f) ≤ deg R f"
using poly_lift_hom_closed[of S h f] UP_cring.deg_leqI[of S "poly_lift_hom R S h f" "deg R f"] assms ring_hom_zero[of h R S] deg_aboveD[of f] coeff_simp[of f]
unfolding P_def UP_cring_def
by (simp add: P_def R.ring_axioms cring.axioms(1) poly_lift_hom_cf)
lemma(in UP_cring) deg_eqI:
assumes "f ∈ carrier (UP R)"
assumes "deg R f ≤ n"
assumes "f n ≠ 𝟬"
shows "deg R f = n"
using assms coeff_simp[of f] P_def deg_leE le_neq_implies_less by blast
lemma(in UP_cring) poly_lift_hom_degree_eq:
assumes "cring S"
assumes "h ∈ ring_hom R S"
assumes "h (lcf f) ≠ 𝟬⇘S⇙"
assumes "f ∈ carrier (UP R)"
shows "deg S (poly_lift_hom R S h f) = deg R f"
apply(rule UP_cring.deg_eqI)
using assms unfolding UP_cring_def apply blast
using poly_lift_hom_closed[of S h f] assms apply blast
using poly_lift_hom_degree_bound[of S h f] assms apply blast
using assms poly_lift_hom_cf[of S h f]
by (metis P_def)
lemma(in UP_cring) poly_lift_hom_lcoeff:
assumes "cring S"
assumes "h ∈ ring_hom R S"
assumes "h (lcf f) ≠ 𝟬⇘S⇙"
assumes "f ∈ carrier (UP R)"
shows "UP_ring.lcf S (poly_lift_hom R S h f) = h (lcf f)"
using poly_lift_hom_degree_eq[of S h f] assms
by (simp add: P_def poly_lift_hom_cf)
end
section‹Coefficient List Constructor for Polynomials›
definition list_to_poly where
"list_to_poly R as n = (if n < length as then as!n else 𝟬⇘R⇙)"
context UP_ring
begin
lemma(in UP_ring) list_to_poly_closed:
assumes "set as ⊆ carrier R"
shows "list_to_poly R as ∈ carrier P"
apply(rule UP_car_memI[of "length as"])
apply (simp add: list_to_poly_def)
by (metis R.zero_closed assms in_mono list_to_poly_def nth_mem)
lemma(in UP_ring) list_to_poly_zero[simp]:
"list_to_poly R [] = 𝟬⇘UP R⇙"
unfolding list_to_poly_def
apply auto
by(simp add: UP_def)
lemma(in UP_domain) list_to_poly_singleton:
assumes "a ∈ carrier R"
shows "list_to_poly R [a] = monom P a 0"
apply(rule ext)
unfolding list_to_poly_def using assms
by (simp add: cfs_monom)
end
definition cf_list where
"cf_list R p = map p [(0::nat)..< Suc (deg R p)]"
lemma cf_list_length:
"length (cf_list R p) = Suc (deg R p)"
unfolding cf_list_def
by simp
lemma cf_list_entries:
assumes "i ≤ deg R p"
shows "(cf_list R p)!i = p i"
unfolding cf_list_def
by (metis add.left_neutral assms diff_zero less_Suc_eq_le map_eq_map_tailrec nth_map_upt)
lemma(in UP_ring) list_to_poly_cf_list_inv:
assumes "p ∈ carrier (UP R)"
shows "list_to_poly R (cf_list R p) = p"
proof
fix x
show "list_to_poly R (cf_list R p) x = p x"
apply(cases "x < degree p")
unfolding list_to_poly_def
using assms cf_list_length[of R p] cf_list_entries[of _ R p]
apply simp
by (metis P_def UP_ring.coeff_simp UP_ring_axioms ‹⋀i. i ≤ deg R p ⟹ cf_list R p ! i = p i› ‹length (cf_list R p) = Suc (deg R p)› assms deg_belowI less_Suc_eq_le)
qed
section‹Polynomial Rings over a Subring›
subsection‹Characterizing the Carrier of a Polynomial Ring over a Subring›
lemma(in ring) carrier_update:
"carrier (R⦇carrier := S⦈) = S"
"𝟬⇘(R⦇carrier := S⦈)⇙ = 𝟬"
"𝟭⇘(R⦇carrier := S⦈)⇙ = 𝟭"
"(⊕⇘(R⦇carrier := S⦈)⇙) = (⊕)"
"(⊗⇘(R⦇carrier := S⦈)⇙) = (⊗)"
by auto
lemma(in UP_cring) poly_cfs_subring:
assumes "subring S R"
assumes "g ∈ carrier (UP R)"
assumes "⋀n. g n ∈ S"
shows "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
apply(rule UP_cring.UP_car_memI')
using R.subcringI' R.subcring_iff UP_cring.intro assms(1) subringE(1) apply blast
proof-
have "carrier (R⦇carrier := S⦈) = S"
using ring.carrier_update by simp
then show 0: "⋀x. g x ∈ carrier (R⦇carrier := S⦈)"
using assms by blast
have 0: "𝟬⇘R⦇carrier := S⦈⇙ = 𝟬"
using R.carrier_update(2) by blast
then show "⋀x. (deg R g) < x ⟹ g x = 𝟬⇘R⦇carrier := S⦈⇙"
using UP_car_memE assms(2) by presburger
qed
lemma(in UP_cring) UP_ring_subring:
assumes "subring S R"
shows "UP_cring (R ⦇ carrier := S ⦈)" "UP_ring (R ⦇ carrier := S ⦈)"
using assms unfolding UP_cring_def
using R.subcringI' R.subcring_iff subringE(1) apply blast
using assms unfolding UP_ring_def
using R.subcringI' R.subcring_iff subringE(1)
by (simp add: R.subring_is_ring)
lemma(in UP_cring) UP_ring_subring_is_ring:
assumes "subring S R"
shows "cring (UP (R ⦇ carrier := S ⦈))"
using assms UP_ring_subring[of S] UP_cring.UP_cring[of "R⦇carrier := S⦈"]
by blast
lemma(in UP_cring) UP_ring_subring_add_closed:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "f ∈ carrier (UP (R ⦇ carrier := S ⦈))"
shows "f ⊕⇘UP (R ⦇ carrier := S ⦈)⇙g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
using assms UP_ring_subring_is_ring[of S]
by (meson cring.cring_simprules(1))
lemma(in UP_cring) UP_ring_subring_mult_closed:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "f ∈ carrier (UP (R ⦇ carrier := S ⦈))"
shows "f ⊗⇘UP (R ⦇ carrier := S ⦈)⇙g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
using assms UP_ring_subring_is_ring[of S]
by (meson cring.carrier_is_subcring subcringE(6))
lemma(in UP_cring) UP_ring_subring_car:
assumes "subring S R"
shows "carrier (UP (R ⦇ carrier := S ⦈)) = {h ∈ carrier (UP R). ∀n. h n ∈ S}"
proof
show "carrier (UP (R⦇carrier := S⦈)) ⊆ {h ∈ carrier (UP R). ∀n. h n ∈ S}"
proof
fix h assume A: "h ∈ carrier (UP (R⦇carrier := S⦈))"
have "h ∈ carrier P"
apply(rule UP_car_memI[of "deg (R⦇carrier := S⦈) h"]) unfolding P_def
using UP_cring.UP_car_memE[of "R⦇carrier := S⦈" h] R.carrier_update[of S]
assms UP_ring_subring A apply presburger
using UP_cring.UP_car_memE[of "R⦇carrier := S⦈" h] assms
by (metis A R.ring_axioms UP_cring_def ‹carrier (R⦇carrier := S⦈) = S› cring.subcringI' is_UP_cring ring.subcring_iff subringE(1) subsetD)
then show "h ∈ {h ∈ carrier (UP R). ∀n. h n ∈ S}"
unfolding P_def
using assms A UP_cring.UP_car_memE[of "R⦇carrier := S⦈" h] R.carrier_update[of S]
UP_ring_subring by blast
qed
show "{h ∈ carrier (UP R). ∀n. h n ∈ S} ⊆ carrier (UP (R⦇carrier := S⦈))"
proof fix h assume A: "h ∈ {h ∈ carrier (UP R). ∀n. h n ∈ S}"
have 0: "h ∈ carrier (UP R)"
using A by blast
have 1: "⋀n. h n ∈ S"
using A by blast
show "h ∈ carrier (UP (R⦇carrier := S⦈))"
apply(rule UP_ring.UP_car_memI[of _ "deg R h"])
using assms UP_ring_subring[of S] UP_cring.axioms UP_ring.intro cring.axioms(1) apply blast
using UP_car_memE[of h] carrier_update 0 R.carrier_update(2) apply presburger
using assms 1 R.carrier_update(1) by blast
qed
qed
lemma(in UP_cring) UP_ring_subring_car_subset:
assumes "subring S R"
shows "carrier (UP (R ⦇ carrier := S ⦈)) ⊆ carrier (UP R)"
proof fix h assume "h ∈ carrier (UP (R ⦇ carrier := S ⦈))"
then show "h ∈ carrier (UP R)"
using assms UP_ring_subring_car[of S] by blast
qed
lemma(in UP_cring) UP_ring_subring_car_subset':
assumes "subring S R"
assumes "h ∈ carrier (UP (R ⦇ carrier := S ⦈))"
shows "h ∈ carrier (UP R)"
using assms UP_ring_subring_car_subset[of S] by blast
lemma(in UP_cring) UP_ring_subring_add:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "f ∈ carrier (UP (R ⦇ carrier := S ⦈))"
shows "g ⊕⇘UP R⇙ f = g ⊕⇘UP (R ⦇ carrier := S ⦈)⇙f"
proof(rule ext) fix x show "(g ⊕⇘UP R⇙ f) x = (g ⊕⇘UP (R⦇carrier := S⦈)⇙ f) x"
proof-
have 0: " (g ⊕⇘P⇙ f) x = g x ⊕ f x"
using assms cfs_add[of g f x] unfolding P_def
using UP_ring_subring_car_subset' by blast
have 1: "(g ⊕⇘UP (R⦇carrier := S⦈)⇙ f) x = g x ⊕⇘R⦇carrier := S⦈⇙ f x"
using UP_ring.cfs_add[of "R ⦇ carrier := S ⦈" g f x] UP_ring_subring[of S] assms
unfolding UP_ring_def UP_cring_def
using R.subring_is_ring by blast
show ?thesis using 0 1 R.carrier_update(4)[of S]
by (simp add: P_def)
qed
qed
lemma(in UP_cring) UP_ring_subring_deg:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
shows "deg R g = deg (R ⦇ carrier := S ⦈) g"
proof-
have 0: "g ∈ carrier (UP R)"
using assms UP_ring_subring_car[of S] by blast
have 1: "deg R g ≤ deg (R ⦇ carrier := S ⦈) g"
using 0 assms UP_cring.UP_car_memE[of "R ⦇ carrier := S ⦈" g]
UP_car_memE[of g] P_def R.carrier_update(2) UP_ring_subring deg_leqI by presburger
have 2: "deg (R ⦇ carrier := S ⦈) g ≤ deg R g"
using 0 assms UP_cring.UP_car_memE[of "R ⦇ carrier := S ⦈" g]
UP_car_memE[of g] P_def R.carrier_update(2) UP_ring_subring UP_cring.deg_leqI
by metis
show ?thesis using 1 2 by presburger
qed
lemma(in UP_cring) UP_subring_monom:
assumes "subring S R"
assumes "a ∈ S"
shows "up_ring.monom (UP R) a n = up_ring.monom (UP (R ⦇ carrier := S ⦈)) a n"
proof fix x
have 0: "a ∈ carrier R"
using assms subringE(1) by blast
have 1: "a ∈ carrier (R⦇carrier := S⦈)"
using assms by (simp add: assms(2))
have 2: " up_ring.monom (UP (R⦇carrier := S⦈)) a n x = (if n = x then a else 𝟬⇘R⦇carrier := S⦈⇙)"
using 1 assms UP_ring_subring[of S] UP_ring.cfs_monom[of "R⦇carrier := S⦈" a n x] UP_cring.axioms UP_ring.intro cring.axioms(1)
by blast
show "up_ring.monom (UP R) a n x = up_ring.monom (UP (R⦇carrier := S⦈)) a n x"
using 0 1 2 cfs_monom[of a n x] R.carrier_update(2)[of S] unfolding P_def by presburger
qed
lemma(in UP_cring) UP_ring_subring_mult:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "f ∈ carrier (UP (R ⦇ carrier := S ⦈))"
shows "g ⊗⇘UP R⇙ f = g ⊗⇘UP (R ⦇ carrier := S ⦈)⇙f"
proof(rule UP_ring.poly_induct3[of "R ⦇ carrier := S ⦈" f])
show "UP_ring (R⦇carrier := S⦈)"
by (simp add: UP_ring_subring(2) assms(1))
show " f ∈ carrier (UP (R⦇carrier := S⦈))"
by (simp add: assms(3))
show " ⋀p q. q ∈ carrier (UP (R⦇carrier := S⦈)) ⟹
p ∈ carrier (UP (R⦇carrier := S⦈)) ⟹
g ⊗⇘UP R⇙ p = g ⊗⇘UP (R⦇carrier := S⦈)⇙ p ⟹
g ⊗⇘UP R⇙ q = g ⊗⇘UP (R⦇carrier := S⦈)⇙ q ⟹ g ⊗⇘UP R⇙ (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q) = g ⊗⇘UP (R⦇carrier := S⦈)⇙ (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q)"
proof- fix p q
assume A: " q ∈ carrier (UP (R⦇carrier := S⦈))"
"p ∈ carrier (UP (R⦇carrier := S⦈))"
"g ⊗⇘UP R⇙ p = g ⊗⇘UP (R⦇carrier := S⦈)⇙ p"
"g ⊗⇘UP R⇙ q = g ⊗⇘UP (R⦇carrier := S⦈)⇙ q"
have 0: "p ⊕⇘UP (R⦇carrier := S⦈)⇙ q = p ⊕⇘UP R⇙ q"
using A UP_ring_subring_add[of S p q]
by (simp add: assms(1))
have 1: "g ⊗⇘UP R⇙ (p ⊕⇘UP R⇙ q) = g ⊗⇘UP R⇙ p ⊕⇘UP R⇙ g ⊗⇘UP R⇙ q"
using 0 A assms P.r_distr P_def UP_ring_subring_car_subset' by auto
hence 2:"g ⊗⇘UP R⇙ (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q) = g ⊗⇘UP R⇙ p ⊕⇘UP R⇙ g ⊗⇘UP R⇙ q"
using 0 by simp
have 3: "g ⊗⇘UP (R⦇carrier := S⦈)⇙ (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q) =
g ⊗⇘UP (R⦇carrier := S⦈)⇙ p ⊕⇘UP (R⦇carrier := S⦈)⇙ g ⊗⇘UP (R⦇carrier := S⦈)⇙ q"
using 0 A assms semiring.r_distr[of "UP (R⦇carrier := S⦈)"] UP_ring_subring_car_subset'
using UP_ring.UP_r_distr ‹UP_ring (R⦇carrier := S⦈)› by blast
hence 4: "g ⊗⇘UP (R⦇carrier := S⦈)⇙ (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q) =
g ⊗⇘UP R⇙ p ⊕⇘UP (R⦇carrier := S⦈)⇙ g ⊗⇘UP R⇙ q"
using A by simp
hence 5: "g ⊗⇘UP (R⦇carrier := S⦈)⇙ (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q) =
g ⊗⇘UP R⇙ p ⊕⇘UP R⇙ g ⊗⇘UP R⇙ q"
using UP_ring_subring_add[of S]
by (simp add: A(1) A(2) A(3) A(4) UP_ring.UP_mult_closed ‹UP_ring (R⦇carrier := S⦈)› assms(1) assms(2))
show "g ⊗⇘UP R⇙ (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q) = g ⊗⇘UP (R⦇carrier := S⦈)⇙ (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q)"
by (simp add: "2" "5")
qed
show "⋀a n. a ∈ carrier (R⦇carrier := S⦈) ⟹ g ⊗⇘UP R⇙ monom (UP (R⦇carrier := S⦈)) a n = g ⊗⇘UP (R⦇carrier := S⦈)⇙ monom (UP (R⦇carrier := S⦈)) a n"
proof fix a n x assume A: "a ∈ carrier (R⦇carrier := S⦈)"
have 0: "monom (UP (R⦇carrier := S⦈)) a n = monom (UP R) a n"
using A UP_subring_monom assms(1) by auto
have 1: "g ∈ carrier (UP R)"
using assms UP_ring_subring_car_subset' by blast
have 2: "a ∈ carrier R"
using A assms subringE(1)[of S R] R.carrier_update[of S] by blast
show "(g ⊗⇘UP R⇙ monom (UP (R⦇carrier := S⦈)) a n) x = (g ⊗⇘UP (R⦇carrier := S⦈)⇙ monom (UP (R⦇carrier := S⦈)) a n) x"
proof(cases "x < n")
case True
have T0: "(g ⊗⇘UP R⇙ monom (UP R) a n) x = 𝟬"
using 1 2 True cfs_monom_mult[of g a x n] A assms unfolding P_def by blast
then show ?thesis using UP_cring.cfs_monom_mult[of "R⦇carrier := S⦈" g a x n] 0 A True
UP_ring_subring(1) assms(1) assms(2) by auto
next
case False
have F0: "(g ⊗⇘UP R⇙ monom (UP R) a n) x = a ⊗ (g (x - n))"
using 1 2 False cfs_monom_mult_l[of g a n "x - n"] A assms unfolding P_def by simp
have F1: "(g ⊗⇘UP (R⦇carrier := S⦈)⇙ monom (UP (R⦇carrier := S⦈)) a n) (x - n + n) = a ⊗⇘R⦇carrier := S⦈⇙ g (x - n)"
using 1 2 False UP_cring.cfs_monom_mult_l[of "R⦇carrier := S⦈" g a n "x - n"] A assms
UP_ring_subring(1) by blast
hence F2: "(g ⊗⇘UP (R⦇carrier := S⦈)⇙ monom (UP R) a n) (x - n + n) = a ⊗ g (x - n)"
using UP_subring_monom[of S a n] R.carrier_update[of S] assms 0 by metis
show ?thesis using F0 F1 1 2 assms
by (simp add: "0" False add.commute add_diff_inverse_nat)
qed
qed
qed
lemma(in UP_cring) UP_ring_subring_one:
assumes "subring S R"
shows "𝟭⇘UP R⇙ = 𝟭⇘UP (R ⦇ carrier := S ⦈)⇙"
using UP_subring_monom[of S 𝟭 0] assms P_def R.subcringI' UP_ring.monom_one UP_ring_subring(2) monom_one subcringE(3) by force
lemma(in UP_cring) UP_ring_subring_zero:
assumes "subring S R"
shows "𝟬⇘UP R⇙ = 𝟬⇘UP (R ⦇ carrier := S ⦈)⇙"
using UP_subring_monom[of S 𝟬 0] UP_ring.monom_zero[of "R ⦇ carrier := S ⦈" 0] assms monom_zero[of 0]
UP_ring_subring[of S] subringE(2)[of S R]
unfolding P_def
by (simp add: P_def R.carrier_update(2))
lemma(in UP_cring) UP_ring_subring_nat_pow:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
shows "g[^]⇘UP R⇙n = g[^]⇘UP (R ⦇ carrier := S ⦈)⇙(n::nat)"
apply(induction n)
using assms apply (simp add: UP_ring_subring_one)
proof-
fix n::nat
assume A: "g [^]⇘UP R⇙ n = g [^]⇘UP (R⦇carrier := S⦈)⇙ n"
have "Group.monoid (UP (R⦇carrier := S⦈)) "
using assms UP_ring_subring[of S] UP_ring.UP_ring[of "R⦇carrier := S⦈"] ring.is_monoid by blast
hence 0 : " g [^]⇘UP (R⦇carrier := S⦈)⇙ n ∈ carrier (UP (R⦇carrier := S⦈))"
using monoid.nat_pow_closed[of "UP (R ⦇ carrier := S ⦈)" g n] assms UP_ring_subring
unfolding UP_ring_def ring_def by blast
have 1: "g [^]⇘UP R⇙ n ∈ carrier (UP R)"
using 0 assms UP_ring_subring_car_subset'[of S] by (simp add: A)
then have 2: "g [^]⇘UP R⇙ n ⊗⇘UP R⇙ g = g [^]⇘UP (R⦇carrier := S⦈)⇙ n ⊗⇘UP (R⦇carrier := S⦈)⇙ g"
using assms UP_ring_subring_mult[of S "g [^]⇘UP R⇙ n" g]
by (simp add: "0" A)
then show "g [^]⇘UP R⇙ Suc n = g [^]⇘UP (R⦇carrier := S⦈)⇙ Suc n"
by simp
qed
lemma(in UP_cring) UP_subring_compose_monom:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "a ∈ S"
shows "compose R (up_ring.monom (UP R) a n) g = compose (R ⦇ carrier := S ⦈) (up_ring.monom (UP (R ⦇ carrier := S ⦈)) a n) g"
proof-
have g_closed: "g ∈ carrier (UP R)"
using assms UP_ring_subring_car by blast
have 0: "a ∈ carrier R"
using assms subringE(1) by blast
have 1: "compose R (up_ring.monom (UP R) a n) g = a ⊙⇘UP R⇙ (g[^]⇘UP R⇙n)"
using monom_sub[of a g n] unfolding P_def
using "0" assms(2) g_closed by blast
have 2: "compose (R⦇carrier := S⦈) (up_ring.monom (UP (R⦇carrier := S⦈)) a n) g = a ⊙⇘UP (R⦇carrier := S⦈)⇙ g [^]⇘UP (R⦇carrier := S⦈)⇙ n"
using assms UP_cring.monom_sub[of "R ⦇ carrier := S ⦈" a g n] UP_ring_subring[of S] R.carrier_update[of S]
by blast
have 3: " g [^]⇘UP (R⦇carrier := S⦈)⇙ n = g[^]⇘UP R⇙n"
using UP_ring_subring_nat_pow[of S g n]
by (simp add: assms(1) assms(2))
have 4: "a ⊙⇘UP R⇙ (g[^]⇘UP R⇙n) = a ⊙⇘UP (R⦇carrier := S⦈)⇙ g [^]⇘UP (R⦇carrier := S⦈)⇙ n"
proof fix x
show "(a ⊙⇘UP R⇙ g [^]⇘UP R⇙ n) x = (a ⊙⇘UP (R⦇carrier := S⦈)⇙ g [^]⇘UP (R⦇carrier := S⦈)⇙ n) x"
proof-
have LHS: "(a ⊙⇘UP R⇙ g [^]⇘UP R⇙ n) x = a ⊗ ((g [^]⇘UP R⇙ n) x)"
using "0" P.nat_pow_closed P_def cfs_smult g_closed by auto
have RHS: "(a ⊙⇘UP (R⦇carrier := S⦈)⇙ g [^]⇘UP (R⦇carrier := S⦈)⇙ n) x = a ⊗⇘R⦇carrier := S⦈⇙ ((g [^]⇘UP (R⦇carrier := S⦈)⇙ n) x)"
proof-
have "Group.monoid (UP (R⦇carrier := S⦈)) "
using assms UP_ring_subring[of S] UP_ring.UP_ring[of "R⦇carrier := S⦈"] ring.is_monoid by blast
hence 0 : " g [^]⇘UP (R⦇carrier := S⦈)⇙ n ∈ carrier (UP (R⦇carrier := S⦈))"
using monoid.nat_pow_closed[of "UP (R ⦇ carrier := S ⦈)" g n] assms UP_ring_subring
unfolding UP_ring_def ring_def by blast
have 1: "g [^]⇘UP (R⦇carrier := S⦈)⇙ n ∈ carrier (UP (R⦇carrier := S⦈))"
using assms UP_ring_subring[of S] R.carrier_update[of S] 0 by blast
then show ?thesis using UP_ring.cfs_smult UP_ring_subring assms
by (simp add: UP_ring.cfs_smult)
qed
show ?thesis using R.carrier_update RHS LHS 3 assms
by simp
qed
qed
show ?thesis using 0 1 2 3 4
by simp
qed
lemma(in UP_cring) UP_subring_compose:
assumes "subring S R"
assumes "g ∈ carrier (UP R)"
assumes "f ∈ carrier (UP R)"
assumes "⋀n. g n ∈ S"
assumes "⋀n. f n ∈ S"
shows "compose R f g = compose (R ⦇ carrier := S ⦈) f g"
proof-
have g_closed: "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
using assms poly_cfs_subring by blast
have 0: "⋀n. (∀ h. h ∈ carrier (UP R) ∧ deg R h ≤ n ∧ h ∈ carrier (UP (R ⦇ carrier := S ⦈)) ⟶ compose R h g = compose (R ⦇ carrier := S ⦈) h g)"
proof- fix n show "(∀ h. h ∈ carrier (UP R) ∧ deg R h ≤ n ∧ h ∈ carrier (UP (R ⦇ carrier := S ⦈)) ⟶ compose R h g = compose (R ⦇ carrier := S ⦈) h g)"
proof(induction n)
show "∀h. h ∈ carrier (UP R) ∧ deg R h ≤ 0 ∧ h ∈ carrier (UP (R⦇carrier := S⦈)) ⟶ Cring_Poly.compose R h g = Cring_Poly.compose (R⦇carrier := S⦈) h g"
proof fix h
show "h ∈ carrier (UP R) ∧ deg R h ≤ 0 ∧ h ∈ carrier (UP (R⦇carrier := S⦈)) ⟶ Cring_Poly.compose R h g = Cring_Poly.compose (R⦇carrier := S⦈) h g"
proof
assume A: "h ∈ carrier (UP R) ∧ deg R h ≤ 0 ∧ h ∈ carrier (UP (R⦇carrier := S⦈))"
then have 0: "deg R h = 0"
by linarith
then have 1: "deg (R ⦇ carrier := S ⦈) h = 0"
using A assms UP_ring_subring_deg[of S h]
by linarith
show "Cring_Poly.compose R h g = Cring_Poly.compose (R⦇carrier := S⦈) h g"
using 0 1 g_closed assms sub_const[of g h] UP_cring.sub_const[of "R⦇carrier := S⦈" g h] A P_def UP_ring_subring
by presburger
qed
qed
show "⋀n. ∀h. h ∈ carrier (UP R) ∧ deg R h ≤ n ∧ h ∈ carrier (UP (R⦇carrier := S⦈)) ⟶
Cring_Poly.compose R h g = Cring_Poly.compose (R⦇carrier := S⦈) h g ⟹
∀h. h ∈ carrier (UP R) ∧ deg R h ≤ Suc n ∧ h ∈ carrier (UP (R⦇carrier := S⦈)) ⟶
Cring_Poly.compose R h g = Cring_Poly.compose (R⦇carrier := S⦈) h g"
proof fix n h
assume IH: "∀h. h ∈ carrier (UP R) ∧ deg R h ≤ n ∧ h ∈ carrier (UP (R⦇carrier := S⦈)) ⟶
Cring_Poly.compose R h g = Cring_Poly.compose (R⦇carrier := S⦈) h g"
show "h ∈ carrier (UP R) ∧ deg R h ≤ Suc n ∧ h ∈ carrier (UP (R⦇carrier := S⦈)) ⟶
Cring_Poly.compose R h g = Cring_Poly.compose (R⦇carrier := S⦈) h g"
proof assume A: "h ∈ carrier (UP R) ∧ deg R h ≤ Suc n ∧ h ∈ carrier (UP (R⦇carrier := S⦈))"
show "Cring_Poly.compose R h g = Cring_Poly.compose (R⦇carrier := S⦈) h g"
proof(cases "deg R h ≤ n")
case True
then show ?thesis using A IH by blast
next
case False
then have F0: "deg R h = Suc n"
using A by (simp add: A le_Suc_eq)
then have F1: "deg (R⦇carrier := S⦈) h = Suc n"
using UP_ring_subring_deg[of S h] A
by (simp add: ‹h ∈ carrier (UP R) ∧ deg R h ≤ Suc n ∧ h ∈ carrier (UP (R⦇carrier := S⦈))› assms(1))
obtain j where j_def: "j ∈ carrier (UP (R⦇carrier := S⦈)) ∧
h = j ⊕⇘UP (R⦇carrier := S⦈)⇙ up_ring.monom (UP (R⦇carrier := S⦈)) (h (deg (R⦇carrier := S⦈) h)) (deg (R⦇carrier := S⦈) h) ∧
deg (R⦇carrier := S⦈) j < deg (R⦇carrier := S⦈) h"
using A UP_ring.ltrm_decomp[of "R⦇carrier := S⦈" h] assms UP_ring_subring[of S]
F1 by (metis (mono_tags, lifting) F0 False zero_less_Suc)
have j_closed: "j ∈ carrier (UP R)"
using j_def assms UP_ring_subring_car_subset by blast
have F2: "deg R j < deg R h"
using j_def assms
by (metis (no_types, lifting) F0 F1 UP_ring_subring_deg)
have F3: "(deg (R⦇carrier := S⦈) h) = deg R h"
by (simp add: F0 F1)
have F30: "h (deg (R⦇carrier := S⦈) h) ∈ S "
using A UP_cring.UP_car_memE[of "R⦇carrier := S⦈" h "deg (R⦇carrier := S⦈) h"]
by (metis R.carrier_update(1) UP_ring_subring(1) assms(1))
hence F4: "up_ring.monom P (h (deg R h)) (deg R h) =
up_ring.monom (UP (R⦇carrier := S⦈)) (h (deg (R⦇carrier := S⦈) h)) (deg (R⦇carrier := S⦈) h)"
using F3 g_closed j_def UP_subring_monom[of S "h (deg (R⦇carrier := S⦈) h)"] assms
unfolding P_def by metis
have F5: "compose R (up_ring.monom (UP R) (h (deg R h)) (deg R h)) g =
compose (R ⦇ carrier := S ⦈) (up_ring.monom (UP (R ⦇ carrier := S ⦈)) (h (deg (R⦇carrier := S⦈) h)) (deg (R⦇carrier := S⦈) h)) g"
using F0 F1 F2 F3 F4 UP_subring_compose_monom[of S] assms P_def ‹h (deg (R⦇carrier := S⦈) h) ∈ S›
by (metis g_closed)
have F5: "compose R j g = compose (R ⦇ carrier := S ⦈) j g"
using F0 F2 IH UP_ring_subring_car_subset' assms(1) j_def by auto
have F6: "h = j ⊕⇘UP R⇙ monom (UP R) (h (deg R h)) (deg R h)"
using j_def F4 UP_ring_subring_add[of S j "up_ring.monom (UP (R⦇carrier := S⦈)) (h (deg (R⦇carrier := S⦈) h)) (deg (R⦇carrier := S⦈) h)"]
UP_ring.monom_closed[of "R⦇carrier := S⦈" "h (deg (R⦇carrier := S⦈) h)" "deg (R⦇carrier := S⦈) h"]
using P_def UP_ring_subring(2) ‹h (deg (R⦇carrier := S⦈) h) ∈ S› assms(1) by auto
have F7: "compose R h g =compose R j g ⊕⇘UP R⇙
compose R (up_ring.monom (UP R) (h (deg R h)) (deg R h)) g"
proof-
show ?thesis
using assms(2) j_closed F5 sub_add[of g j "up_ring.monom P (h (deg R h)) (deg R h)" ]
F4 F3 F2 F1 g_closed unfolding P_def
by (metis A F6 ltrm_closed P_def)
qed
have F8: "compose (R ⦇ carrier := S ⦈) h g = compose (R ⦇ carrier := S ⦈) j g ⊕⇘UP (R ⦇ carrier := S ⦈)⇙
compose (R ⦇ carrier := S ⦈) (up_ring.monom (UP (R ⦇ carrier := S ⦈)) (h (deg (R ⦇ carrier := S ⦈) h)) (deg (R ⦇ carrier := S ⦈) h)) g"
proof-
have 0: " UP_cring (R⦇carrier := S⦈)"
by (simp add: UP_ring_subring(1) assms(1))
have 1: "monom (UP (R⦇carrier := S⦈)) (h (deg R h)) (deg R h) ∈ carrier (UP (R⦇carrier := S⦈))"
using assms 0 F30 UP_ring.monom_closed[of "R⦇carrier := S⦈" "h (deg R h)" "deg R h"] R.carrier_update[of S]
unfolding UP_ring_def UP_cring_def
by (simp add: F3 cring.axioms(1))
show ?thesis
using 0 1 g_closed j_def UP_cring.sub_add[of "R ⦇ carrier := S ⦈" g j "monom (UP (R⦇carrier := S⦈)) (h (deg R h)) (deg R h)" ]
using F3 by auto
qed
have F9: "compose R j g ∈ carrier (UP R)"
by (simp add: UP_cring.sub_closed assms(2) is_UP_cring j_closed)
have F10: "compose (R ⦇ carrier := S ⦈) j g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
using assms j_def UP_cring.sub_closed[of "R ⦇ carrier := S ⦈"] UP_ring_subring(1) g_closed by blast
have F11: " compose R (up_ring.monom (UP R) (h (deg R h)) (deg R h)) g ∈ carrier (UP R)"
using assms j_def UP_cring.sub_closed[of "R ⦇ carrier := S ⦈"]
UP_ring.monom_closed[of "R ⦇ carrier := S ⦈"]
by (simp add: A UP_car_memE(1) UP_cring.rev_sub_closed UP_ring.monom_closed is_UP_cring is_UP_ring sub_rev_sub)
have F12: " compose (R ⦇ carrier := S ⦈) (up_ring.monom (UP (R ⦇ carrier := S ⦈)) (h (deg (R ⦇ carrier := S ⦈) h)) (deg (R ⦇ carrier := S ⦈) h)) g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
using assms j_def UP_cring.sub_closed[of "R ⦇ carrier := S ⦈"]
UP_ring.monom_closed[of "R ⦇ carrier := S ⦈"] UP_ring_subring[of S]
using A UP_ring.ltrm_closed g_closed by fastforce
show ?thesis using F9 F10 F11 F12 F7 F8 F5 UP_ring_subring_add[of S "compose R j g" "compose R (up_ring.monom (UP R) (h (deg R h)) (deg R h)) g"]
assms
using F3 F30 UP_subring_compose_monom g_closed by auto
qed
qed
qed
qed
qed
show ?thesis using 0[of "deg R f"]
by (simp add: assms(1) assms(3) assms(5) poly_cfs_subring)
qed
subsection‹Evaluation over a Subring›
lemma(in UP_cring) UP_subring_eval:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "a ∈ S"
shows "to_function R g a = to_function (R ⦇ carrier := S ⦈) g a"
apply(rule UP_ring.poly_induct3[of "R ⦇ carrier := S ⦈" g] )
apply (simp add: UP_ring_subring(2) assms(1))
apply (simp add: assms(2))
proof-
show "⋀p q. q ∈ carrier (UP (R⦇carrier := S⦈)) ⟹
p ∈ carrier (UP (R⦇carrier := S⦈)) ⟹
to_function R p a = to_function (R⦇carrier := S⦈) p a ⟹
to_function R q a = to_function (R⦇carrier := S⦈) q a ⟹
to_function R (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q) a = to_function (R⦇carrier := S⦈) (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q) a"
proof- fix p q assume A: "q ∈ carrier (UP (R⦇carrier := S⦈))"
"p ∈ carrier (UP (R⦇carrier := S⦈))"
" to_function R p a = to_function (R⦇carrier := S⦈) p a"
" to_function R q a = to_function (R⦇carrier := S⦈) q a"
have a_closed: "a ∈ carrier R"
using assms R.carrier_update[of S] subringE(1) by blast
have 0: "UP_cring (R⦇carrier := S⦈)"
using assms by (simp add: UP_ring_subring(1))
have 1: "to_function (R⦇carrier := S⦈) p a ∈ S"
using A 0 UP_cring.to_fun_closed[of "R⦇carrier := S⦈"]
by (simp add: UP_cring.to_fun_def assms(3))
have 2: "to_function (R⦇carrier := S⦈) q a ∈ S"
using A 0 UP_cring.to_fun_closed[of "R⦇carrier := S⦈"]
by (simp add: UP_cring.to_fun_def assms(3))
have 3: "p ∈ carrier (UP R)"
using A assms 0 UP_ring_subring_car_subset' by blast
have 4: "q ∈ carrier (UP R)"
using A assms 0 UP_ring_subring_car_subset' by blast
have 5: "to_fun p a ⊕ to_fun q a = UP_cring.to_fun (R⦇carrier := S⦈) p a ⊕⇘R⦇carrier := S⦈⇙ UP_cring.to_fun (R⦇carrier := S⦈) q a"
using 1 2 A R.carrier_update[of S] assms by (simp add: "0" UP_cring.to_fun_def to_fun_def)
have 6: "UP_cring.to_fun (R⦇carrier := S⦈) (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q) a =
UP_cring.to_fun (R⦇carrier := S⦈) p a ⊕⇘R⦇carrier := S⦈⇙ UP_cring.to_fun (R⦇carrier := S⦈) q a"
using UP_cring.to_fun_plus[of "R ⦇ carrier := S ⦈" q p a]
by (simp add: "0" A(1) A(2) assms(3))
have 7: "to_fun (p ⊕⇘P⇙ q) a = to_fun p a ⊕ to_fun q a"
using to_fun_plus[of q p a] 3 4 a_closed by (simp add: P_def)
have 8: "p ⊕⇘UP (R⦇carrier := S⦈)⇙ q = p ⊕⇘P⇙ q"
unfolding P_def using assms A R.carrier_update[of S] UP_ring_subring_add[of S p q] by simp
show "to_function R (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q) a = to_function (R⦇carrier := S⦈) (p ⊕⇘UP (R⦇carrier := S⦈)⇙ q) a"
using UP_ring_subring_car_subset'[of S ] 0 1 2 3 4 5 6 7 8 A R.carrier_update[of S]
unfolding P_def by (simp add: UP_cring.to_fun_def to_fun_def)
qed
show "⋀b n.
b ∈ carrier (R⦇carrier := S⦈) ⟹
to_function R (monom (UP (R⦇carrier := S⦈)) b n) a = to_function (R⦇carrier := S⦈) (monom (UP (R⦇carrier := S⦈)) b n) a"
proof- fix b n assume A: "b ∈ carrier (R⦇carrier := S⦈)"
have 0: "UP_cring (R⦇carrier := S⦈)"
by (simp add: UP_ring_subring(1) assms(1))
have a_closed: "a ∈ carrier R"
using assms subringE by blast
have 1: "UP_cring.to_fun (R⦇carrier := S⦈) (monom (UP (R⦇carrier := S⦈)) b n) a = b ⊗⇘R⦇carrier := S⦈⇙ a [^]⇘R⦇carrier := S⦈⇙ n"
using assms A UP_cring.to_fun_monom[of "R⦇carrier := S⦈" b a n]
by (simp add: "0")
have 2: "UP_cring.to_fun (R⦇carrier := S⦈) (monom (UP (R⦇carrier := S⦈)) b n) ≡ to_function (R⦇carrier := S⦈) (monom (UP (R⦇carrier := S⦈)) b n)"
using UP_cring.to_fun_def[of "R⦇carrier := S⦈" "monom (UP (R⦇carrier := S⦈)) b n"] 0 by linarith
have 3: "(monom (UP (R⦇carrier := S⦈)) b n) = monom P b n"
using A assms unfolding P_def using UP_subring_monom by auto
have 4: " b ⊗ a [^] n = b ⊗⇘R⦇carrier := S⦈⇙ a [^]⇘R⦇carrier := S⦈⇙ n"
apply(induction n) using R.carrier_update[of S] apply simp
using R.carrier_update[of S] R.nat_pow_consistent by auto
hence 5: "to_function R (monom (UP (R⦇carrier := S⦈)) b n) a = b ⊗⇘R⦇carrier := S⦈⇙ a[^]⇘R⦇carrier := S⦈⇙n"
using 0 1 2 3 assms A UP_cring.to_fun_monom[of "R⦇carrier := S⦈" b a n] UP_cring.to_fun_def[of "R⦇carrier := S⦈" "monom (UP (R⦇carrier := S⦈)) b n"]
R.carrier_update[of S] subringE[of S R] a_closed UP_ring.monom_closed[of "R⦇carrier := S⦈" a n]
to_fun_monom[of b a n]
unfolding P_def UP_cring.to_fun_def to_fun_def by (metis subsetD)
thus " to_function R (monom (UP (R⦇carrier := S⦈)) b n) a = to_function (R⦇carrier := S⦈) (monom (UP (R⦇carrier := S⦈)) b n) a"
using "1" "2" by auto
qed
qed
lemma(in UP_cring) UP_subring_eval':
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "a ∈ S"
shows "to_fun g a = to_function (R ⦇ carrier := S ⦈) g a"
unfolding to_fun_def using assms
by (simp add: UP_subring_eval)
lemma(in UP_cring) UP_subring_eval_closed:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "a ∈ S"
shows "to_fun g a ∈ S"
using assms UP_subring_eval'[of S g a] UP_cring.to_fun_closed UP_cring.to_fun_def R.carrier_update(1) UP_ring_subring(1) by fastforce
subsection‹Derivatives and Taylor Expansions over a Subring›
lemma(in UP_cring) UP_subring_taylor:
assumes "subring S R"
assumes "g ∈ carrier (UP R)"
assumes "⋀n. g n ∈ S"
assumes "a ∈ S"
shows "taylor_expansion R a g = taylor_expansion (R ⦇ carrier := S ⦈) a g"
proof-
have a_closed: "a ∈ carrier R"
using assms subringE by blast
have 0: "X_plus a ∈ carrier (UP R)"
using assms X_plus_closed unfolding P_def
using local.a_closed by auto
have 1: "⋀n. X_plus a n ∈ S"
proof- fix n
have "X_plus a n = (if n = 0 then a else
(if n = 1 then 𝟭 else 𝟬))"
using a_closed
by (simp add: cfs_X_plus)
then show "X_plus a n ∈ S" using subringE assms
by (simp add: subringE(2) subringE(3))
qed
have 2: "(X_poly_plus (R⦇carrier := S⦈) a) = X_plus a"
proof-
have 20: "(X_poly_plus (R⦇carrier := S⦈) a) = (λk. if k = (0::nat) then a else
(if k = 1 then 𝟭 else 𝟬))"
using a_closed assms UP_cring.cfs_X_plus[of "R⦇carrier := S⦈" a] R.carrier_update
UP_ring_subring(1) by auto
have 21: "X_plus a = (λk. if k = (0::nat) then a else
(if k = 1 then 𝟭 else 𝟬))"
using cfs_X_plus[of a] a_closed
by blast
show ?thesis apply(rule ext) using 20 21
by auto
qed
show ?thesis
unfolding taylor_expansion_def using 0 1 2 assms UP_subring_compose[of S g "X_plus a"]
by (simp add: UP_subring_compose)
qed
lemma(in UP_cring) UP_subring_taylor_closed:
assumes "subring S R"
assumes "g ∈ carrier (UP R)"
assumes "⋀n. g n ∈ S"
assumes "a ∈ S"
shows "taylor_expansion R a g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
proof-
have "g ∈ carrier (UP (R⦇carrier := S⦈))"
by (metis P_def R.carrier_update(1) R.carrier_update(2) UP_cring.UP_car_memI' UP_ring_subring(1) assms(1) assms(2) assms(3) deg_leE)
then show ?thesis
using assms UP_cring.taylor_def[of "R⦇carrier := S⦈"] UP_subring_taylor[of S g a]
UP_cring.taylor_closed[of "R ⦇ carrier := S ⦈" g a] UP_ring_subring(1)[of S] by simp
qed
lemma(in UP_cring) UP_subring_taylor_closed':
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "a ∈ S"
shows "taylor_expansion R a g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
using UP_subring_taylor_closed assms UP_cring.UP_car_memE[of "R ⦇ carrier := S ⦈" g] R.carrier_update[of S]
UP_ring_subring(1) UP_ring_subring_car_subset' by auto
lemma(in UP_cring) UP_subring_taylor':
assumes "subring S R"
assumes "g ∈ carrier (UP R)"
assumes "⋀n. g n ∈ S"
assumes "a ∈ S"
shows "taylor_expansion R a g n ∈ S"
using assms UP_subring_taylor R.carrier_update[of S] UP_cring.taylor_closed[of "R ⦇ carrier := S ⦈"]
using UP_cring.taylor_expansion_cf_closed UP_ring_subring(1) poly_cfs_subring by metis
lemma(in UP_cring) UP_subring_deriv:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "a ∈ S"
shows "deriv g a= UP_cring.deriv (R ⦇ carrier := S ⦈) g a"
proof-
have 0: "(⋀n. g n ∈ S)"
using assms UP_ring_subring_car by blast
thus ?thesis
unfolding derivative_def using 0 UP_ring_subring_car_subset[of S] assms UP_subring_taylor[of S g a]
by (simp add: subset_iff)
qed
lemma(in UP_cring) UP_subring_deriv_closed:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "a ∈ S"
shows "deriv g a ∈ S"
using assms UP_cring.deriv_closed[of "R ⦇ carrier := S ⦈" g a] UP_subring_deriv[of S g a]
UP_ring_subring_car_subset[of S] UP_ring_subring[of S]
by simp
lemma(in UP_cring) poly_shift_subring_closed:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
shows "poly_shift g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
using UP_cring.poly_shift_closed[of "R ⦇ carrier := S ⦈" g] assms UP_ring_subring[of S]
by simp
lemma(in UP_cring) UP_subring_taylor_appr:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "a ∈ S"
assumes "b ∈ S"
shows "∃c ∈ S. to_fun g a= to_fun g b ⊕ (deriv g b)⊗ (a ⊖ b) ⊕ (c ⊗ (a ⊖ b)[^](2::nat))"
proof-
have a_closed: "a ∈ carrier R"
using assms subringE by blast
have b_closed: "b ∈ carrier R"
using assms subringE by blast
have g_closed: " g ∈ carrier (UP R)"
using UP_ring_subring_car_subset[of S] assms by blast
have 0: "to_fun (shift 2 (T⇘b⇙ g)) (a ⊖ b) = to_fun (shift 2 (T⇘b⇙ g)) (a ⊖ b)"
by simp
have 1: "to_fun g b = to_fun g b"
by simp
have 2: "deriv g b = deriv g b"
by simp
have 3: "to_fun g a = to_fun g b ⊕ deriv g b ⊗ (a ⊖ b) ⊕ to_fun (shift 2 (T⇘b⇙ g)) (a ⊖ b) ⊗ (a ⊖ b) [^] (2::nat)"
using taylor_deg_1_expansion[of g b a "to_fun (shift 2 (T⇘b⇙ g)) (a ⊖ b)" "to_fun g b" "deriv g b"]
assms a_closed b_closed g_closed 0 1 2 unfolding P_def by blast
have 4: "to_fun (shift 2 (T⇘b⇙ g)) (a ⊖ b) ∈ S"
proof-
have 0: "(2::nat) = Suc (Suc 0)"
by simp
have 1: "a ⊖ b ∈ S"
using assms unfolding a_minus_def
by (simp add: subringE(5) subringE(7))
have 2: "poly_shift (T⇘b⇙ g) ∈ carrier (UP (R⦇carrier := S⦈))"
using poly_shift_subring_closed[of S "taylor_expansion R b g"] UP_ring_subring[of S]
UP_subring_taylor_closed'[of S g b] assms unfolding taylor_def
by blast
hence 3: "poly_shift (poly_shift (T⇘b⇙ g)) ∈ carrier (UP (R⦇carrier := S⦈))"
using UP_cring.poly_shift_closed[of "R⦇carrier := S⦈" "(poly_shift (T⇘b⇙ g))"]
unfolding taylor_def
using assms(1) poly_shift_subring_closed by blast
have 4: "to_fun (poly_shift (poly_shift (T⇘b⇙ g))) (a ⊖ b) ∈ S"
using 1 2 3 0 UP_subring_eval_closed[of S "poly_shift (poly_shift (T⇘b⇙ g))" "a ⊖ b"]
UP_cring.poly_shift_closed[of "R⦇carrier := S⦈"] assms
by blast
then show ?thesis
by (simp add: numeral_2_eq_2)
qed
obtain c where c_def: "c = to_fun (shift 2 (T⇘b⇙ g)) (a ⊖ b)"
by blast
have 5: "c ∈ S ∧ to_fun g a = to_fun g b ⊕ deriv g b ⊗ (a ⊖ b) ⊕ c ⊗ (a ⊖ b) [^] (2::nat)"
unfolding c_def using 3 4 by blast
thus ?thesis using c_def 4 by blast
qed
lemma(in UP_cring) UP_subring_taylor_appr':
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
assumes "a ∈ S"
assumes "b ∈ S"
shows "∃c c' c''. c ∈ S ∧ c' ∈ S ∧ c'' ∈ S ∧ to_fun g a= c ⊕ c'⊗ (a ⊖ b) ⊕ (c'' ⊗ (a ⊖ b)[^](2::nat))"
using UP_subring_taylor_appr[of S g a b] assms UP_subring_deriv_closed[of S g b] UP_subring_eval_closed[of S g b]
by blast
lemma (in UP_cring) pderiv_cfs:
assumes"g ∈ carrier (UP R)"
shows "pderiv g n = [Suc n]⋅(g (Suc n))"
unfolding pderiv_def
using n_mult_closed[of g] assms poly_shift_cfs[of "n_mult g" n]
unfolding P_def n_mult_def by blast
lemma(in ring) subring_add_pow:
assumes "subring S R"
assumes "a ∈ S"
shows "[(n::nat)] ⋅⇘R⦇carrier := S⦈⇙ a = [(n::nat)] ⋅a"
proof-
have 0: "a ∈ carrier R"
using assms(1) assms(2) subringE(1) by blast
have 1: "a ∈ carrier (R⦇carrier := S⦈)"
by (simp add: assms(2))
show ?thesis
apply(induction n)
using assms 0 1 carrier_update[of S]
apply (simp add: add_pow_def)
using assms 0 1 carrier_update[of S]
by (simp add: add_pow_def)
qed
lemma(in UP_cring) UP_subring_pderiv_equal:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
shows "pderiv g = UP_cring.pderiv (R⦇carrier := S⦈) g"
proof fix n
show "pderiv g n = UP_cring.pderiv (R⦇carrier := S⦈) g n"
using UP_cring.pderiv_cfs[of "R ⦇ carrier := S ⦈" g n] pderiv_cfs[of g n]
assms R.subring_add_pow[of S "g (Suc n)" "Suc n"]
by (simp add: UP_ring_subring(1) UP_ring_subring_car)
qed
lemma(in UP_cring) UP_subring_pderiv_closed:
assumes "subring S R"
assumes "g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
shows "pderiv g ∈ carrier (UP (R ⦇ carrier := S ⦈))"
using assms UP_cring.pderiv_closed[of "R ⦇ carrier := S ⦈" g] R.carrier_update(1) UP_ring_subring(1)
UP_subring_pderiv_equal by auto
lemma(in UP_cring) UP_subring_pderiv_closed':
assumes "subring S R"
assumes "g ∈ carrier (UP R)"
assumes "⋀n. g n ∈ S"
shows "⋀n. pderiv g n ∈ S"
using assms UP_subring_pderiv_closed[of S g] poly_cfs_subring[of S g] UP_ring_subring_car
by blast
lemma(in UP_cring) taylor_deg_one_expansion_subring:
assumes "f ∈ carrier (UP R)"
assumes "subring S R"
assumes "⋀i. f i ∈ S"
assumes "a ∈ S"
assumes "b ∈ S"
shows "∃c ∈ S. to_fun f b = (to_fun f a) ⊕ (deriv f a) ⊗ (b ⊖ a) ⊕ (c ⊗ (b ⊖ a)[^](2::nat))"
apply(rule UP_subring_taylor_appr, rule assms)
using assms poly_cfs_subring apply blast
by(rule assms, rule assms)
lemma(in UP_cring) taylor_deg_one_expansion_subring':
assumes "f ∈ carrier (UP R)"
assumes "subring S R"
assumes "⋀i. f i ∈ S"
assumes "a ∈ S"
assumes "b ∈ S"
shows "∃c ∈ S. to_fun f b = (to_fun f a) ⊕ (to_fun (pderiv f) a) ⊗ (b ⊖ a) ⊕ (c ⊗ (b ⊖ a)[^](2::nat))"
proof-
have "S ⊆ carrier R"
using assms subringE(1) by blast
hence 0: "deriv f a = to_fun (pderiv f) a"
using assms pderiv_eval_deriv[of f a] unfolding P_def by blast
show ?thesis
using assms taylor_deg_one_expansion_subring[of f S a b]
unfolding 0 by blast
qed
end
Theory Supplementary_Ring_Facts
theory Supplementary_Ring_Facts
imports "HOL-Algebra.Ring"
"HOL-Algebra.UnivPoly"
"HOL-Algebra.Subrings"
begin
section‹Supplementary Ring Facts›
text‹The nonzero elements of a ring.›
definition nonzero :: "('a, 'b) ring_scheme ⇒ 'a set" where
"nonzero R = {a ∈ carrier R. a ≠ 𝟬⇘R⇙}"
lemma zero_not_in_nonzero:
"𝟬⇘R⇙ ∉ nonzero R"
unfolding nonzero_def by blast
lemma(in domain) nonzero_memI:
assumes "a ∈ carrier R"
assumes "a ≠ 𝟬"
shows "a ∈ nonzero R"
using assms by(simp add: nonzero_def)
lemma(in domain) nonzero_memE:
assumes "a ∈ nonzero R"
shows "a ∈ carrier R" "a ≠𝟬"
using assms by(auto simp: nonzero_def)
lemma(in domain) not_nonzero_memE:
assumes "a ∉ nonzero R"
assumes "a ∈ carrier R"
shows "a = 𝟬"
using assms
by (simp add: nonzero_def)
lemma(in domain) not_nonzero_memI:
assumes "a = 𝟬"
shows "a ∉ nonzero R"
using assms nonzero_memE(2) by auto
lemma(in domain) nonzero_closed:
assumes "a ∈ nonzero R"
shows "a ∈ carrier R"
using assms
by (simp add: nonzero_def)
lemma(in domain) nonzero_mult_in_car:
assumes "a ∈ nonzero R"
assumes "b ∈ nonzero R"
shows "a ⊗ b ∈ carrier R"
using assms
by (simp add: nonzero_def)
lemma(in domain) nonzero_mult_closed:
assumes "a ∈ nonzero R"
assumes "b ∈ nonzero R"
shows "a ⊗ b ∈ nonzero R"
apply(rule nonzero_memI)
using assms nonzero_memE apply blast
using assms nonzero_memE
by (simp add: integral_iff)
lemma(in domain) nonzero_one_closed:
"𝟭 ∈ nonzero R"
by (simp add: nonzero_def)
lemma(in domain) one_nonzero:
"𝟭 ∈ nonzero R"
by (simp add: nonzero_one_closed)
lemma(in domain) nat_pow_nonzero:
assumes "x ∈nonzero R"
shows "x[^](n::nat) ∈ nonzero R"
unfolding nonzero_def
apply(induction n)
using assms integral_iff nonzero_closed zero_not_in_nonzero by auto
lemma(in monoid) Units_int_pow_closed:
assumes "x ∈ Units G"
shows "x[^](n::int) ∈ Units G"
by (metis Units_pow_closed assms int_pow_def2 monoid.Units_inv_Units monoid_axioms)
lemma(in comm_monoid) UnitsI:
assumes "a ∈ carrier G"
assumes "b ∈ carrier G"
assumes "a ⊗ b = 𝟭"
shows "a ∈ Units G" "b ∈ Units G"
unfolding Units_def using comm_monoid_axioms_def assms m_comm[of a b]
by auto
lemma(in comm_monoid) is_invI:
assumes "a ∈ carrier G"
assumes "b ∈ carrier G"
assumes "a ⊗ b = 𝟭"
shows "inv⇘G⇙ b = a" "inv⇘G⇙ a = b"
using assms inv_char m_comm
by auto
lemma(in ring) ring_in_Units_imp_not_zero:
assumes "𝟭 ≠ 𝟬"
assumes "a ∈ Units R"
shows "a ≠ 𝟬"
using assms monoid.Units_l_cancel
by (metis l_null monoid_axioms one_closed zero_closed)
lemma(in ring) Units_nonzero:
assumes "u ∈ Units R"
assumes "𝟭⇘R⇙ ≠ 𝟬⇘R⇙"
shows "u ∈ nonzero R"
proof-
have "u ∈carrier R"
using Units_closed assms by auto
have "u ≠𝟬"
using Units_r_inv_ex assms(1) assms(2)
by force
thus ?thesis
by (simp add: ‹u ∈ carrier R› nonzero_def)
qed
lemma(in ring) Units_inverse:
assumes "u ∈ Units R"
shows "inv u ∈ Units R"
by (simp add: assms)
lemma(in cring) invI:
assumes "x ∈ carrier R"
assumes "y ∈ carrier R"
assumes "x ⊗⇘R⇙ y = 𝟭⇘R⇙"
shows "y = inv ⇘R⇙ x"
"x = inv ⇘R⇙ y"
using assms(1) assms(2) assms(3) is_invI
by auto
lemma(in cring) inv_cancelR:
assumes "x ∈ Units R"
assumes "y ∈ carrier R"
assumes "z ∈ carrier R"
assumes "y = x ⊗⇘R⇙ z"
shows "inv⇘R⇙ x ⊗⇘R⇙ y = z"
"y ⊗⇘R⇙ (inv⇘R⇙ x) = z"
apply (metis Units_closed assms(1) assms(3) assms(4) cring.cring_simprules(12)
is_cring m_assoc monoid.Units_inv_closed monoid.Units_l_inv monoid_axioms)
by (metis Units_closed assms(1) assms(3) assms(4) m_assoc m_comm monoid.Units_inv_closed
monoid.Units_r_inv monoid.r_one monoid_axioms)
lemma(in cring) inv_cancelL:
assumes "x ∈ Units R"
assumes "y ∈ carrier R"
assumes "z ∈ carrier R"
assumes "y = z ⊗⇘R⇙ x"
shows "inv⇘R⇙ x ⊗⇘R⇙ y = z"
"y ⊗⇘R⇙ (inv⇘R⇙ x) = z"
apply (simp add: Units_closed assms(1) assms(3) assms(4) m_lcomm)
by (simp add: Units_closed assms(1) assms(3) assms(4) m_assoc)
end
Theory Extended_Int
section ‹Extended integers (i.e. with infinity)›
text‹
This section formalizes the extended integers, which serve as the codomain for the $p$-adic
valuation. The element $\infty$ is added to the integers to serve as a maximxal element in the
order, which is the valuation of $0$.
›
theory Extended_Int
imports Main "HOL-Library.Countable" "HOL-Library.Order_Continuity" "HOL-Library.Extended_Nat"
begin
text‹
The following is based very closely on the theory \<^theory>‹HOL-Library.Extended_Nat› from the
standard Isabelle distribution, with adaptations made to formalize the integers extended with
an element for infinity. This is the standard range for the valuation function on a discretely
valued ring such as the field of $p$-adic numbers, such as in \cite{engler2005valued}.
›
context
fixes f :: "nat ⇒ 'a::{canonically_ordered_monoid_add, linorder_topology, complete_linorder}"
begin
lemma sums_SUP[simp, intro]: "f sums (SUP n. ∑i<n. f i)"
unfolding sums_def by (intro LIMSEQ_SUP monoI sum_mono2 zero_le) auto
lemma suminf_eq_SUP: "suminf f = (SUP n. ∑i<n. f i)"
using sums_SUP by (rule sums_unique[symmetric])
end
subsection ‹Type definition›
text ‹
We extend the standard natural numbers by a special value indicating
infinity.
›
typedef eint = "UNIV :: int option set" ..
definition eint :: "int ⇒ eint" where
"eint n = Abs_eint (Some n)"
instantiation eint :: infinity
begin
definition "∞ = Abs_eint None"
instance ..
end
fun int_option_enumeration :: "int option ⇒ nat" where
"int_option_enumeration (Some n) = (if n ≥ 0 then nat (2*(n + 1)) else nat (2*(-n) + 1))"|
"int_option_enumeration None = (0::nat)"
lemma int_option_enumeration_inj:
"inj int_option_enumeration"
proof
have pos_even: "⋀n::int. n ≥ 0 ⟹ even (int_option_enumeration (Some n)) ∧ (int_option_enumeration (Some n))> 0"
proof-
fix n::int assume "n ≥0" then have "(int_option_enumeration (Some n)) = nat (2*(n + 1))"
by simp
then show "even (int_option_enumeration (Some n)) ∧ 0 < int_option_enumeration (Some n)"
by (smt ‹0 ≤ n› even_of_nat int_nat_eq oddE zero_less_nat_eq)
qed
have neg_odd: "⋀n::int. n < 0 ⟹ odd (int_option_enumeration (Some n))"
by (smt evenE even_of_nat int_nat_eq int_option_enumeration.simps(1))
fix x y assume A: "x ∈ UNIV" "y ∈ UNIV" "int_option_enumeration x = int_option_enumeration y"
show "x = y"
apply(cases "x = None")
using A pos_even neg_odd
apply (metis dvd_0_right int_option_enumeration.elims int_option_enumeration.simps(2) not_gr0 not_le)
proof-
assume "x ≠None"
then obtain n where n_def: "x = Some n"
by auto
then have y_not_None: "y ≠ None"
using A
by (metis ‹⋀thesis. (⋀n. x = Some n ⟹ thesis) ⟹ thesis›
add_cancel_right_right even_add int_option_enumeration.simps(2)
linorder_not_less neg_odd neq0_conv pos_even)
then obtain m where m_def: "y = Some m"
by blast
show ?thesis
proof(cases "n ≥0")
case True
then show ?thesis
using n_def A neg_odd pos_even m_def int_option_enumeration.simps(1)
by (smt int_nat_eq)
next
case False
then show ?thesis
using n_def A neg_odd pos_even m_def int_option_enumeration.simps(1)
by (smt int_nat_eq)
qed
qed
qed
definition eint_enumeration where
"eint_enumeration = int_option_enumeration ∘ Rep_eint"
lemma eint_enumeration_inj:
"inj eint_enumeration"
unfolding eint_enumeration_def
using int_option_enumeration_inj Rep_eint_inject
by (metis (mono_tags, lifting) comp_apply injD inj_on_def)
instance eint :: countable
proof
show "∃to_int::eint ⇒ nat. inj to_int"
using eint_enumeration_inj by blast
qed
old_rep_datatype eint "∞ :: eint"
proof -
fix P i assume "⋀j. P (eint j)" "P ∞"
then show "P i"
proof induct
case (Abs_eint y) then show ?case
by (cases y rule: option.exhaust)
(auto simp: eint_def infinity_eint_def)
qed
qed (auto simp add: eint_def infinity_eint_def Abs_eint_inject)
declare [[coercion "eint::int⇒eint"]]
lemmas eint2_cases = eint.exhaust[case_product eint.exhaust]
lemmas eint3_cases = eint.exhaust[case_product eint.exhaust eint.exhaust]
lemma not_infinity_eq [iff]: "(x ≠ ∞) = (∃i. x = eint i)"
by (cases x) auto
lemma not_eint_eq [iff]: "(∀y. x ≠ eint y) = (x = ∞)"
by (cases x) auto
lemma eint_ex_split: "(∃c::eint. P c) ⟷ P ∞ ∨ (∃c::int. P c)"
by (metis eint.exhaust)
primrec the_eint :: "eint ⇒ int"
where "the_eint (eint n) = n"
subsection ‹Constructors and numbers›
instantiation eint :: zero_neq_one
begin
definition
"0 = eint 0"
definition
"1 = eint 1"
instance
proof qed (simp add: zero_eint_def one_eint_def)
end
lemma eint_0 [code_post]: "eint 0 = 0"
by (simp add: zero_eint_def)
lemma eint_1 [code_post]: "eint 1 = 1"
by (simp add: one_eint_def)
lemma eint_0_iff: "eint x = 0 ⟷ x = 0" "0 = eint x ⟷ x = 0"
by (auto simp add: zero_eint_def)
lemma eint_1_iff: "eint x = 1 ⟷ x = 1" "1 = eint x ⟷ x = 1"
by (auto simp add: one_eint_def)
lemma infinity_ne_i0 [simp]: "(∞::eint) ≠ 0"
by (simp add: zero_eint_def)
lemma i0_ne_infinity [simp]: "0 ≠ (∞::eint)"
by (simp add: zero_eint_def)
lemma zero_one_eint_neq:
"¬ 0 = (1::eint)"
"¬ 1 = (0::eint)"
unfolding zero_eint_def one_eint_def by simp_all
lemma infinity_ne_i1 [simp]: "(∞::eint) ≠ 1"
by (simp add: one_eint_def)
lemma i1_ne_infinity [simp]: "1 ≠ (∞::eint)"
by (simp add: one_eint_def)
subsection ‹Addition›
instantiation eint :: comm_monoid_add
begin
definition [nitpick_simp]:
"m + n = (case m of ∞ ⇒ ∞ | eint m ⇒ (case n of ∞ ⇒ ∞ | eint n ⇒ eint (m + n)))"
lemma plus_eint_simps [simp, code]:
fixes q :: eint
shows "eint m + eint n = eint (m + n)"
and "∞ + q = ∞"
and "q + ∞ = ∞"
by (simp_all add: plus_eint_def split: eint.splits)
instance
proof
fix n m q :: eint
show "n + m + q = n + (m + q)"
by (cases n m q rule: eint3_cases) auto
show "n + m = m + n"
by (cases n m rule: eint2_cases) auto
show "0 + n = n"
by (cases n) (simp_all add: zero_eint_def)
qed
end
lemma eSuc_eint: "(eint n) + 1 = eint (n + 1)"
by (simp add: one_eint_def)
lemma eSuc_infinity [simp]: " ∞ + (1::eint) = ∞"
unfolding plus_eint_def
by auto
lemma eSuc_inject [simp]: " m + (1::eint)= n + 1 ⟷ m = n"
unfolding plus_eint_def
apply(cases "m = ∞")
apply (metis (no_types, lifting) eSuc_eint
eint.distinct(2) eint.exhaust eint.simps(4) eint.simps(5) plus_eint_def)
apply(cases "n = ∞")
using eSuc_eint plus_eint_def apply auto[1]
unfolding one_eint_def
using add.commute eSuc_eint
by auto
lemma eSuc_eint_iff: "x + 1 = eint y ⟷ (∃n. y = n + 1 ∧ x = eint n)"
apply(cases "x = ∞")
apply simp
unfolding plus_eint_def one_eint_def
using eSuc_eint
by auto
lemma enat_eSuc_iff: "eint y = x + 1 ⟷ (∃n. y = n + 1 ∧ eint n = x)"
using eSuc_eint_iff
by metis
lemma iadd_Suc: "((m::eint) + 1) + n = (m + n) + 1"
by (metis ab_semigroup_add_class.add_ac(1) add.assoc add.commute)
lemma iadd_Suc_right: "(m::eint) + (n + 1) = (m + n) + 1"
using add.assoc[of m n 1] by auto
subsection ‹Multiplication›
instantiation eint :: "{comm_semiring}"
begin
definition times_eint_def [nitpick_simp]:
"m * n = (case m of ∞ ⇒ ∞ | eint m ⇒
(case n of ∞ ⇒ ∞ | eint n ⇒ eint (m * n)))"
lemma times_eint_simps [simp, code]:
"eint m * eint n = eint (m * n)"
"∞ * ∞ = (∞::eint)"
"∞ * eint n = ∞"
"eint m * ∞ = ∞"
unfolding times_eint_def zero_eint_def
by (simp_all split: eint.split)
lemma sum_infinity_imp_summand_infinity:
assumes "a + b = (∞::eint)"
shows "a = ∞ ∨ b = ∞"
using assms
by (metis not_eint_eq plus_eint_simps(1))
lemma sum_finite_imp_summands_finite:
assumes "a + b ≠ (∞::eint)"
shows "a ≠ ∞" "b ≠ ∞"
using assms eint.simps(5) apply fastforce
using assms eint.simps(5) by fastforce
instance
proof
fix a b c :: eint
show "(a * b) * c = a * (b * c)"
unfolding times_eint_def zero_eint_def
by (simp split: eint.split)
show comm: "a * b = b * a"
unfolding times_eint_def zero_eint_def
by (simp split: eint.split)
show distr: "(a + b) * c = a * c + b * c"
unfolding times_eint_def plus_eint_def
apply(cases "a + b = ∞")
apply(cases "a = ∞")
apply simp
using sum_infinity_imp_summand_infinity[of a b]
apply (metis eint.simps(5) plus_eint_def plus_eint_simps(3))
apply(cases "c = ∞")
apply (metis eint.exhaust plus_eint_def plus_eint_simps(3) times_eint_def times_eint_simps(4))
using sum_finite_imp_summands_finite[of a b]
apply auto
by (simp add: semiring_normalization_rules(1))
qed
end
lemma mult_one_right[simp]:
"(n::eint)*1 = n"
apply(cases "n = ∞")
apply (simp add: one_eint_def)
by (metis eint2_cases mult_cancel_left2 one_eint_def times_eint_simps(1))
lemma mult_one_left[simp]:
"1*(n::eint) = n"
by (metis mult.commute mult_one_right)
lemma mult_eSuc: "((m::eint) + 1) * n = m * n + n"
by (simp add: distrib_right)
lemma mult_eSuc': "((m::eint) + 1) * n = n + m * n"
using mult_eSuc add.commute by simp
lemma mult_eSuc_right: "(m::eint) * (n + 1) = m * n + m "
by(simp add: distrib_left)
lemma mult_eSuc_right': "(m::eint) * (n + 1) = m + m * n "
using mult_eSuc_right add.commute by simp
subsection ‹Numerals›
lemma numeral_eq_eint:
"numeral k = eint (numeral k)"
by simp
lemma eint_numeral [code_abbrev]:
"eint (numeral k) = numeral k"
using numeral_eq_eint ..
lemma infinity_ne_numeral [simp]: "(∞::eint) ≠ numeral k"
by auto
lemma numeral_ne_infinity [simp]: "numeral k ≠ (∞::eint)"
by simp
subsection ‹Subtraction›
instantiation eint :: minus
begin
definition diff_eint_def:
"a - b = (case a of (eint x) ⇒ (case b of (eint y) ⇒ eint (x - y) | ∞ ⇒ ∞)
| ∞ ⇒ ∞)"
instance ..
end
lemma idiff_eint_eint [simp, code]: "eint a - eint b = eint (a - b)"
by (simp add: diff_eint_def)
lemma idiff_infinity [simp, code]: "∞ - n = (∞::eint)"
by (simp add: diff_eint_def)
lemma idiff_infinity_right [simp, code]: "eint a - ∞ = ∞"
by (simp add: diff_eint_def)
lemma idiff_0 [simp]: "(0::eint) - n = -n"
by (cases n, simp_all add: zero_eint_def)
lemmas idiff_eint_0 [simp] = idiff_0 [unfolded zero_eint_def]
lemma idiff_0_right [simp]: "(n::eint) - 0 = n"
by (cases n) (simp_all add: zero_eint_def)
lemmas idiff_eint_0_right [simp] = idiff_0_right [unfolded zero_eint_def]
lemma idiff_self [simp]: "n ≠ ∞ ⟹ (n::eint) - n = 0"
by (auto simp: zero_eint_def)
lemma eSuc_minus_eSuc [simp]: "((n::eint) + 1) - (m + 1) = n - m"
apply(cases "n = ∞")
apply simp
apply(cases "m = ∞")
apply (metis eSuc_infinity eint.exhaust idiff_infinity_right infinity_ne_i1 sum_infinity_imp_summand_infinity)
proof-
assume A: "n ≠∞" "m ≠ ∞"
obtain a where a_def: "n = eint a"
using A
by auto
obtain b where b_def: "m = eint b"
using A
by auto
show ?thesis
using idiff_eint_eint[of "a + 1" "b + 1"]
idiff_eint_eint[of a b]
by (simp add: a_def b_def eSuc_eint)
qed
lemma eSuc_minus_1 [simp]: "((n::eint)+ 1) - 1 = n"
using eSuc_minus_eSuc[of n 0]
by auto
subsection ‹Ordering›
instantiation eint :: linordered_ab_semigroup_add
begin
definition [nitpick_simp]:
"m ≤ n = (case n of eint n1 ⇒ (case m of eint m1 ⇒ m1 ≤ n1 | ∞ ⇒ False)
| ∞ ⇒ True)"
definition [nitpick_simp]:
"m < n = (case m of eint m1 ⇒ (case n of eint n1 ⇒ m1 < n1 | ∞ ⇒ True)
| ∞ ⇒ False)"
lemma eint_ord_simps [simp]:
"eint m ≤ eint n ⟷ m ≤ n"
"eint m < eint n ⟷ m < n"
"q ≤ (∞::eint)"
"q < (∞::eint) ⟷ q ≠ ∞"
"(∞::eint) ≤ q ⟷ q = ∞"
"(∞::eint) < q ⟷ False"
by (simp_all add: less_eq_eint_def less_eint_def split: eint.splits)
lemma numeral_le_eint_iff[simp]:
shows "numeral m ≤ eint n ⟷ numeral m ≤ n"
by auto
lemma numeral_less_eint_iff[simp]:
shows "numeral m < eint n ⟷ numeral m < n"
by simp
lemma eint_ord_code [code]:
"eint m ≤ eint n ⟷ m ≤ n"
"eint m < eint n ⟷ m < n"
"q ≤ (∞::eint) ⟷ True"
"eint m < ∞ ⟷ True"
"∞ ≤ eint n ⟷ False"
"(∞::eint) < q ⟷ False"
by simp_all
lemma eint_ord_plus_one[simp]:
assumes "eint n ≤ x"
assumes "x < y"
shows "eint (n + 1) ≤ y"
proof-
obtain m where "x = eint m"
using assms(2)
by fastforce
show ?thesis apply(cases "y = ∞")
apply simp
using ‹x = eint m› assms(1) assms(2)
by force
qed
instance
by standard (auto simp add: less_eq_eint_def less_eint_def plus_eint_def split: eint.splits)
end
instance eint :: "{strict_ordered_comm_monoid_add}"
proof
show "a < b ⟹ c < d ⟹ a + c < b + d" for a b c d :: eint
by (cases a b c d rule: eint2_cases[case_product eint2_cases]) auto
qed
lemma add_diff_assoc_eint: "z ≤ y ⟹ x + (y - z) = x + y - (z::eint)"
by(cases x)(auto simp add: diff_eint_def split: eint.split)
lemma eint_ord_number [simp]:
"(numeral m :: eint) ≤ numeral n ⟷ (numeral m :: nat) ≤ numeral n"
"(numeral m :: eint) < numeral n ⟷ (numeral m :: nat) < numeral n"
apply simp
by simp
lemma infinity_ileE [elim!]: "∞ ≤ eint m ⟹ R"
by simp
lemma infinity_ilessE [elim!]: "∞ < eint m ⟹ R"
by simp
lemma imult_infinity: "(0::eint) < n ⟹ ∞ * n = ∞"
by (simp add: zero_eint_def less_eint_def split: eint.splits)
lemma imult_infinity_right: "(0::eint) < n ⟹ n * ∞ = ∞"
by (simp add: zero_eint_def less_eint_def split: eint.splits)
lemma min_eint_simps [simp]:
"min (eint m) (eint n) = eint (min m n)"
"min q (∞::eint) = q"
"min (∞::eint) q = q"
by (auto simp add: min_def)
lemma max_eint_simps [simp]:
"max (eint m) (eint n) = eint (max m n)"
"max q ∞ = (∞::eint)"
"max ∞ q = (∞::eint)"
by (simp_all add: max_def)
lemma eint_ile: "n ≤ eint m ⟹ ∃k. n = eint k"
by (cases n) simp_all
lemma eint_iless: "n < eint m ⟹ ∃k. n = eint k"
by (cases n) simp_all
lemma iadd_le_eint_iff:
"x + y ≤ eint n ⟷ (∃y' x'. x = eint x' ∧ y = eint y' ∧ x' + y' ≤ n)"
by(cases x y rule: eint.exhaust[case_product eint.exhaust]) simp_all
lemma chain_incr: "∀i. ∃j. Y i < Y j ⟹ ∃j. eint k < Y j"
proof-
assume A: "∀i. ∃j. Y i < Y j"
then have "∀i. ∃n::int. Y i = eint n"
by (metis eint.exhaust eint_ord_simps(6))
then obtain i n where in_def: "Y (i::'a) = eint n"
by blast
show "∃j. eint k < Y j"
proof(rule ccontr)
assume C: "¬(∃j. eint k < Y j)"
then have C':"∀j. Y j ≤ eint k"
using le_less_linear
by blast
then have "Y (i::'a) ≤ eint k"
by simp
have "⋀m::nat. ∃j::'a. Y j ≥ eint (n + int m)"
proof- fix m
show "∃j::'a. Y j ≥ eint (n + int m)"
apply(induction m)
apply (metis in_def int_ops(1) order_refl plus_int_code(1))
proof- fix m
assume "∃j. eint (n + int m) ≤ Y j"
then obtain j where j_def: "eint (n + int m) ≤ Y j"
by blast
obtain j' where j'_def: "Y j < Y j'"
using A by blast
have "eint (n + int (Suc m)) = eint (n + m + 1)"
by auto
then have "eint (n + int (Suc m)) ≤ Y j'"
using j_def j'_def eint_ord_plus_one[of "n + m" "Y j" "Y j'"]
by presburger
then show "∃j. eint (n + int (Suc m)) ≤ Y j"
by blast
qed
qed
then show False
by (metis A C ‹Y i ≤ eint k› eint_ord_simps(1) in_def
order.not_eq_order_implies_strict zle_iff_zadd)
qed
qed
lemma eint_ord_Suc:
assumes "(x::eint) < y"
shows "x + 1 < y + 1"
apply(cases "y = ∞")
using assms i1_ne_infinity sum_infinity_imp_summand_infinity
apply fastforce
by (metis add_mono_thms_linordered_semiring(3) assms eSuc_inject order_less_le)
lemma eSuc_ile_mono [simp]: "(n::eint) + 1 ≤ m+ 1 ⟷ n ≤ m"
by (meson add_mono_thms_linordered_semiring(3) eint_ord_Suc linorder_not_le)
lemma eSuc_mono [simp]: "(n::eint) + 1 < m+ 1 ⟷ n < m"
by (meson add_mono_thms_linordered_semiring(3) eint_ord_Suc linorder_not_le)
lemma ile_eSuc [simp]: "(n::eint) ≤ n + 1"
by (metis add.right_neutral add_left_mono eint_1_iff(2) eint_ord_code(1) linear not_one_le_zero zero_eint_def)
lemma ileI1: "(m::eint) < n ⟹ m + 1 ≤ n"
by (metis eSuc_eint eint.exhaust eint_ex_split eint_iless eint_ord_Suc eint_ord_code(6)
eint_ord_plus_one eint_ord_simps(3) less_le_trans linear )
lemma Suc_ile_eq: "eint (m +1) ≤ n ⟷ eint m < n"
by (cases n) auto
lemma iless_Suc_eq [simp]: "eint m < n + 1 ⟷ eint m ≤ n"
by (metis Suc_ile_eq eSuc_eint eSuc_ile_mono)
lemma eSuc_max: "(max (x::eint) y) + 1 = max (x+1) (y+1)"
by (simp add: max_def)
lemma eSuc_Max:
assumes "finite A" "A ≠ ({}::eint set)"
shows " (Max A) + 1 = Max ((+)1 ` A)"
using assms proof induction
case (insert x A)
thus ?case
using Max_insert[of A x] Max_singleton[of x] add.commute[of 1] eSuc_max finite_imageI
image_insert image_is_empty
by (simp add: add.commute hom_Max_commute)
qed simp
instantiation eint :: "{order_top}"
begin
definition top_eint :: eint where "top_eint = ∞"
instance
by standard (simp add: top_eint_def)
end
lemma finite_eint_bounded:
assumes le_fin: "⋀y. y ∈ A ⟹ eint m ≤ y ∧ y ≤ eint n"
shows "finite A"
proof (rule finite_subset)
show "finite (eint ` {m..n})" by blast
have "A ⊆ {eint m..eint n}" using le_fin by fastforce
also have "… ⊆ eint ` {m..n}"
apply (rule subsetI)
subgoal for x by (cases x) auto
done
finally show "A ⊆ eint ` {m..n}" .
qed
subsection ‹Cancellation simprocs›
lemma add_diff_cancel_eint[simp]: "x ≠ ∞ ⟹ x + y - x = (y::eint)"
by (metis add.commute add.right_neutral add_diff_assoc_eint idiff_self order_refl)
lemma eint_add_left_cancel: "a + b = a + c ⟷ a = (∞::eint) ∨ b = c"
unfolding plus_eint_def by (simp split: eint.split)
lemma eint_add_left_cancel_le: "a + b ≤ a + c ⟷ a = (∞::eint) ∨ b ≤ c"
unfolding plus_eint_def by (simp split: eint.split)
lemma eint_add_left_cancel_less: "a + b < a + c ⟷ a ≠ (∞::eint) ∧ b < c"
unfolding plus_eint_def by (simp split: eint.split)
lemma plus_eq_infty_iff_eint: "(m::eint) + n = ∞ ⟷ m=∞ ∨ n=∞"
using eint_add_left_cancel by fastforce
ML ‹
structure Cancel_Enat_Common =
struct
fun find_first_t _ _ [] = raise TERM("find_first_t", [])
| find_first_t past u (t::terms) =
if u aconv t then (rev past @ terms)
else find_first_t (t::past) u terms
fun dest_summing (Const (\<^const_name>‹Groups.plus›, _) $ t $ u, ts) =
dest_summing (t, dest_summing (u, ts))
| dest_summing (t, ts) = t :: ts
val mk_sum = Arith_Data.long_mk_sum
fun dest_sum t = dest_summing (t, [])
val find_first = find_first_t []
val trans_tac = Numeral_Simprocs.trans_tac
val norm_ss =
simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps @{thms ac_simps add_0_left add_0_right})
fun norm_tac ctxt = ALLGOALS (simp_tac (put_simpset norm_ss ctxt))
fun simplify_meta_eq ctxt cancel_th th =
Arith_Data.simplify_meta_eq [] ctxt
([th, cancel_th] MRS trans)
fun mk_eq (a, b) = HOLogic.mk_Trueprop (HOLogic.mk_eq (a, b))
end
structure Eq_Enat_Cancel = ExtractCommonTermFun
(open Cancel_Enat_Common
val mk_bal = HOLogic.mk_eq
val dest_bal = HOLogic.dest_bin \<^const_name>‹HOL.eq› \<^typ>‹eint›
fun simp_conv _ _ = SOME @{thm eint_add_left_cancel}
)
structure Le_Enat_Cancel = ExtractCommonTermFun
(open Cancel_Enat_Common
val mk_bal = HOLogic.mk_binrel \<^const_name>‹Orderings.less_eq›
val dest_bal = HOLogic.dest_bin \<^const_name>‹Orderings.less_eq› \<^typ>‹eint›
fun simp_conv _ _ = SOME @{thm eint_add_left_cancel_le}
)
structure Less_Enat_Cancel = ExtractCommonTermFun
(open Cancel_Enat_Common
val mk_bal = HOLogic.mk_binrel \<^const_name>‹Orderings.less›
val dest_bal = HOLogic.dest_bin \<^const_name>‹Orderings.less› \<^typ>‹eint›
fun simp_conv _ _ = SOME @{thm eint_add_left_cancel_less}
)
›
simproc_setup eint_eq_cancel
("(l::eint) + m = n" | "(l::eint) = m + n") =
‹fn phi => fn ctxt => fn ct => Eq_Enat_Cancel.proc ctxt (Thm.term_of ct)›
simproc_setup eint_le_cancel
("(l::eint) + m ≤ n" | "(l::eint) ≤ m + n") =
‹fn phi => fn ctxt => fn ct => Le_Enat_Cancel.proc ctxt (Thm.term_of ct)›
simproc_setup eint_less_cancel
("(l::eint) + m < n" | "(l::eint) < m + n") =
‹fn phi => fn ctxt => fn ct => Less_Enat_Cancel.proc ctxt (Thm.term_of ct)›
text ‹TODO: add regression tests for these simprocs›
text ‹TODO: add simprocs for combining and cancelling numerals›
subsection ‹Well-ordering›
lemma less_eintE:
"[| n < eint m; !!k. n = eint k ==> k < m ==> P |] ==> P"
by (induct n) auto
lemma less_infinityE:
"[| n < ∞; !!k. n = eint k ==> P |] ==> P"
by (induct n) auto
subsection ‹Traditional theorem names›
lemmas eint_defs = zero_eint_def one_eint_def
plus_eint_def less_eq_eint_def less_eint_def
instantiation eint :: uminus
begin
definition
"- b = (case b of ∞ ⇒ ∞ | eint m ⇒ eint (-m))"
lemma eint_uminus_eq:
"(a::eint) + (-a) = a - a"
apply(induction a)
apply (simp add: uminus_eint_def)
by simp
instance..
end
section‹Additional Lemmas (Useful for the Proof of Hensel's Lemma)›
lemma eint_mult_mono:
assumes "(c::eint) > 0 ∧ c ≠ ∞"
assumes "k > n"
shows "k*c > n*c"
using assms apply(induction k, induction n, induction c)
by(auto simp add: zero_eint_def)
lemma eint_mult_mono':
assumes "(c::eint) ≥ 0 ∧ c ≠ ∞"
assumes "k > n"
shows "k*c ≥ n*c"
apply(cases "c = 0")
apply (metis add.right_neutral assms(2) eint_add_left_cancel eint_ord_code(3)
eint_ord_simps(4) eq_iff less_le_trans mult.commute mult_eSuc_right'
mult_one_right not_less times_eint_simps(4) zero_eint_def)
using assms eint_mult_mono
by (simp add: le_less)
lemma eint_minus_le:
assumes "(b::eint) < c"
shows "c - b > 0"
using assms apply(induction b, induction c)
by (auto simp add: zero_eint_def)
lemma eint_nat_times:
assumes "(c::eint) > 0"
shows "(Suc n)*(c::eint) > 0"
using assms apply(induction c)
apply (simp add: zero_eint_def)
by simp
lemma eint_pos_times_is_pos:
assumes "(c::eint) > 0"
assumes "b > 0"
shows "b*c > 0"
using assms apply(induction c, induction b)
by(auto simp add: zero_eint_def imult_infinity_right)
lemma eint_nat_is_pos:
"eint (Suc n) > 0"
by (simp add: zero_eint_def)
lemma eint_pow_int_is_pos:
assumes "n > 0"
shows "eint n > 0"
using assms by (simp add: zero_eint_def)
lemma eint_nat_times':
assumes "(c::eint) ≥ 0"
shows "(Suc n)*c ≥ 0"
using assms zero_eint_def by fastforce
lemma eint_pos_int_times_ge:
assumes "(c::eint) ≥ 0"
assumes "n > 0"
shows "eint n * c ≥ c"
using assms apply(induction c)
apply (smt eSuc_eint eint.distinct(2) eint_mult_mono' eint_pow_int_is_pos eq_iff ileI1 less_le mult.commute mult_one_right one_eint_def zero_eint_def)
by simp
lemma eint_pos_int_times_gt:
assumes "(c::eint) > 0"
assumes "c ≠∞"
assumes "n > 1"
shows "eint n * c > c"
using assms eint_mult_mono[of c 1 "eint n"]
by (metis eint_ord_simps(2) mult_one_left one_eint_def)
lemma eint_add_cancel_fact[simp]:
assumes "(c::eint) ≠ ∞"
shows "c + (b - c) = b"
using assms apply(induction c, induction b)
by auto
lemma nat_mult_not_infty[simp]:
assumes "c ≠ ∞"
shows "(eint n) * c ≠ ∞"
using assms by auto
lemma eint_minus_distl:
assumes "(b::eint) ≠ d"
shows "b*c - d*c = (b-d)*c"
using assms apply(induction c, induction b, induction d)
apply (metis add_diff_cancel_eint distrib_right eint.distinct(2) eint_add_cancel_fact nat_mult_not_infty)
apply simp
apply simp
by (simp add: mult.commute times_eint_def)
lemma eint_minus_distr:
assumes "(b::eint) ≠ d"
shows "c*(b - d) = c*b - c*d"
by (metis assms eint_minus_distl mult.commute)
lemma eint_int_minus_distr:
"(eint n)*c - (eint m)*c = eint (n - m) * c"
by (metis add.right_neutral distrib_right eint_add_left_cancel eint_minus_distl idiff_eint_eint
idiff_infinity idiff_self infinity_ne_i0 nat_mult_not_infty not_eint_eq times_eint_simps(4))
lemma eint_2_minus_1_mult[simp]:
"2*(b::eint) - b = b"
proof -
have "∀e. (∞::eint) * e = ∞"
by (simp add: times_eint_def)
then show ?thesis
by (metis add_diff_cancel_eint idiff_infinity mult.commute mult_eSuc_right' mult_one_right one_add_one one_eint_def plus_eint_simps(1))
qed
lemma eint_minus_comm:
"(d::eint) + b - c = d - c + b"
apply(induction c )
apply (metis add.assoc add_diff_cancel_eint eint.distinct(2) eint_add_cancel_fact)
apply(induction d)
apply (metis distrib_left eint2_cases eint_minus_distl i1_ne_infinity idiff_infinity_right
mult_one_left plus_eq_infty_iff_eint sum_infinity_imp_summand_infinity times_eint_simps(3))
apply(induction b)
apply simp
by simp
lemma ge_plus_pos_imp_gt:
assumes "(c::eint) ≠∞"
assumes "(b::eint) > 0"
assumes "d ≥ c + b"
shows "d > c"
using assms apply(induction d, induction c)
apply (metis add.comm_neutral assms(2) eint_add_left_cancel_less less_le_trans)
apply blast
by simp
lemma eint_minus_ineq:
assumes "(c::eint) ≠∞"
assumes "b ≥ d"
shows "b - c ≥ d - c"
by (metis add_left_mono antisym assms(1) assms(2) eint_add_cancel_fact linear)
lemma eint_minus_ineq':
assumes "(c::eint) ≠∞"
assumes "b ≥ d"
assumes "(e::eint) > 0"
assumes "e ≠ ∞"
shows "e*(b - c) ≥ e*(d - c)"
using assms eint_minus_ineq
by (metis eint_mult_mono' eq_iff less_le mult.commute)
lemma eint_minus_ineq'':
assumes "(c::eint) ≠∞"
assumes "b ≥ d"
assumes "(e::eint) > 0"
assumes "e ≠ ∞"
shows "e*(b - c) ≥ e*d - e*c"
using assms eint_minus_ineq'
proof -
have "∀e. (0::eint) + e = e"
by simp
then have f1: "e * 0 = 0"
by (metis add_diff_cancel_eint assms(4) idiff_self mult_eSuc_right' mult_one_right)
have "∞ ≠ c * e"
using assms(1) assms(4) eint_pos_times_is_pos by auto
then show ?thesis
using f1 by (metis assms(1) assms(2) assms(3) assms(4) eint_minus_distl eint_minus_ineq' idiff_self mult.commute)
qed
lemma eint_min_ineq:
assumes "(b::eint) ≥ min c d"
assumes "c > e"
assumes "d > e"
shows "b > e"
by (meson assms(1) assms(2) assms(3) less_le_trans min_le_iff_disj)
lemma eint_plus_times:
assumes "(d::eint) ≥ 0"
assumes "(b::eint) ≥ c + (eint k)*d"
assumes "k ≥ l"
shows "b ≥ c + l*d"
proof-
have "k*d ≥ l*d"
by (smt assms(1) assms(3) eint_mult_mono' eint_ord_simps(2) eq_iff times_eint_simps(4))
thus ?thesis
by (meson add_mono_thms_linordered_semiring(2) assms(2) order_subst2)
qed
end
Theory Padic_Construction
theory Padic_Construction
imports "HOL-Number_Theory.Residues" "HOL-Algebra.RingHom" "HOL-Algebra.IntRing"
begin
type_synonym padic_int = "nat ⇒ int"
section ‹Inverse Limit Construction of the $p$-adic Integers›
text‹
This section formalizes the standard construction of the $p$-adic integers as the inverse
limit of the finite rings $\mathbb{Z} / p^n \mathbb{Z}$ along the residue maps
$\mathbb{Z} / p^n \mathbb{Z} \mapsto \mathbb{Z} / p^n \mathbb{Z} $ defined by
$x \mapsto x \mod p^m$ when $n \geq m$. This is exposited, for example, in section 7.6 of
\cite{dummit2004abstract}. The other main route for formalization is to first define the
$p$-adic absolute value $|\cdot|_p$ on the rational numbers, and then define the field
$\mathbb{Q}_p$ of $p$-adic numbers as the completion of the rationals under this absolute
value. One can then define the ring of $p$-adic integers $\mathbb{Z}_p$ as the unit ball in
$\mathbb{Q}_p$ using the unique extension of $|\cdot|_p$. There exist advantages and
disadvantages to both approaches. The primary advantage to the absolute value approach is
that the construction can be done generically using existing libraries for completions of
normed fields. There are difficulties associated with performing such a construction in
Isabelle using existing HOL formalizations. The chief issue is that the tools in HOL-Analysis
require that a metric space be a type. If one then wanted to construct the fields
$\mathbb{Q}_p$ as metric spaces, one would have to circumvent the apparent dependence on
the parameter $p$, as Isabelle does not support dependent types. A workaround to this proposed
by José Manuel Rodríguez Caballero on the Isabelle mailing list is to define a typeclass for
fields $\mathbb{Q}_p$ as the completions of the rational numbers with a non-Archimedean absolute
value. By Ostrowski's Theorem, any such absolute value must be a $p$-adic absolute value. We can
recover the parameter $p$ from a completion under one of these absolute values as the cardinality
of the residue field.
Our approach uses HOL-Algebra, where algebraic structures are constructed as records which carry
the data of the underlying carrier set plus other algebraic operations, and assumptions about
these structures can be organized into locales. This approach is practical for abstract
algebraic reasoning where definitions of structures which are dependent on object-level
parameters are ubiquitous. Using this approach, we define $\mathbb{Z}_p$ directly as an
inverse limit of rings, from which $\mathbb{Q}_p$ can later be defined as the field of fractions.
›
subsection‹Canonical Projection Maps Between Residue Rings›
definition residue :: "int ⇒ int ⇒ int" where
"residue n m = m mod n"
lemma residue_is_hom_0:
assumes "n > 1"
shows "residue n ∈ ring_hom 𝒵 (residue_ring n)"
proof(rule ring_hom_memI)
have R: "residues n"
by (simp add: assms residues_def)
show "⋀x. x ∈ carrier 𝒵 ⟹ residue n x ∈ carrier (residue_ring n)"
using assms residue_def residues.mod_in_carrier residues_def by auto
show " ⋀x y. x ∈ carrier 𝒵 ⟹ y ∈ carrier 𝒵 ⟹
residue n (x ⊗⇘𝒵⇙ y) = residue n x ⊗⇘residue_ring n⇙ residue n y"
by (simp add: R residue_def residues.mult_cong)
show "⋀x y. x ∈ carrier 𝒵 ⟹
y ∈ carrier 𝒵 ⟹
residue n (x ⊕⇘𝒵⇙ y) = residue n x ⊕⇘residue_ring n⇙ residue n y"
by (simp add: R residue_def residues.res_to_cong_simps(1))
show "residue n 𝟭⇘𝒵⇙ = 𝟭⇘residue_ring n⇙"
by (simp add: R residue_def residues.res_to_cong_simps(4))
qed
text‹The residue map is a ring homomorphism from $\mathbb{Z}/m\mathbb{Z} \to \mathbb{Z}/n\mathbb{Z}$ when n divides m›
lemma residue_is_hom_1:
assumes "n > 1"
assumes "m > 1"
assumes "n dvd m"
shows "residue n ∈ ring_hom (residue_ring m) (residue_ring n)"
proof(rule ring_hom_memI)
have 0: "residues n"
by (simp add: assms(1) residues_def)
have 1: "residues m"
by (simp add: assms(2) residues_def)
show "⋀x. x ∈ carrier (residue_ring m) ⟹ residue n x ∈ carrier (residue_ring n)"
using assms(1) residue_def residue_ring_def by auto
show "⋀x y. x ∈ carrier (residue_ring m) ⟹
y ∈ carrier (residue_ring m) ⟹
residue n (x ⊗⇘residue_ring m⇙ y) = residue n x ⊗⇘residue_ring n⇙ residue n y"
using 0 1 assms by (metis mod_mod_cancel residue_def residues.mult_cong residues.res_mult_eq)
show "⋀x y. x ∈ carrier (residue_ring m)
⟹ y ∈ carrier (residue_ring m)
⟹ residue n (x ⊕⇘residue_ring m⇙ y) = residue n x ⊕⇘residue_ring n⇙ residue n y"
using 0 1 assms by (metis mod_mod_cancel residue_def residues.add_cong residues.res_add_eq)
show "residue n 𝟭⇘residue_ring m⇙ = 𝟭⇘residue_ring n⇙"
by (simp add: assms(1) residue_def residue_ring_def)
qed
lemma residue_id:
assumes "x ∈ carrier (residue_ring n)"
assumes "n ≥0"
shows "residue n x = x"
proof(cases "n=0")
case True
then show ?thesis
by (simp add: residue_def)
next
case False
have 0: "x ≥0"
using assms(1) by (simp add: residue_ring_def)
have 1: "x < n"
using assms(1) residue_ring_def by auto
have "x mod n = x"
using 0 1 by simp
then show ?thesis
using residue_def by auto
qed
text‹
The residue map is a ring homomorphism from
$\mathbb{Z}/p^n\mathbb{Z} \to \mathbb{Z}/p^m\mathbb{Z}$ when $n \geq m$:
›
lemma residue_hom_p:
assumes "(n::nat) ≥ m"
assumes "m >0"
assumes "prime (p::int)"
shows "residue (p^m) ∈ ring_hom (residue_ring (p^n)) (residue_ring (p^m))"
proof(rule residue_is_hom_1)
show " 1 < p^n" using assms
using prime_gt_1_int by auto
show "1 < p^m"
by (simp add: assms(2) assms(3) prime_gt_1_int)
show "p ^ m dvd p ^ n" using assms(1)
by (simp add: dvd_power_le)
qed
subsection‹Defining the Set of $p$-adic Integers›
text‹
The set of $p$-adic integers is the set of all maps $f: \mathbb{N} \to \mathbb{Z}$ which maps
$n \to \{0,...,p^n -1\}$ such that $f m \mod p^{n} = f n$ when $m \geq n$. A p-adic integer $x$
consists of the data of a residue map $x \mapsto x\mod p^n$ which commutes with further reduction
$\mod p^m$. This formalization is specialized to just the $p$-adics, but this definition would
work essentially as-is for any family of rings and residue maps indexed by a partially
ordered type.
›
definition padic_set :: "int ⇒ padic_int set" where
"padic_set p = {f::nat ⇒ int .(∀ m::nat. (f m) ∈ carrier (residue_ring (p^m)))
∧(∀(n::nat) (m::nat). n > m ⟶ residue (p^m) (f n) = (f m)) }"
lemma padic_set_res_closed:
assumes "f ∈ padic_set p"
shows "(f m) ∈ (carrier (residue_ring (p^m)))"
using assms padic_set_def by auto
lemma padic_set_res_coherent:
assumes "f ∈ padic_set p"
assumes "n ≥ m"
assumes "prime p"
shows "residue (p^m) (f n) = (f m)"
proof(cases "n=m")
case True
have "(f m) ∈ carrier (residue_ring (p^m))"
using assms padic_set_res_closed by blast
then have "residue (p^m) (f m) = (f m)"
by (simp add: residue_def residue_ring_def)
then show ?thesis
using True by blast
next
case False
then show ?thesis
using assms(1) assms(2) padic_set_def by auto
qed
text‹
A consequence of this formalization is that each $p$-adic number is trivially
defined to take a value of $0$ at $0$:
›
lemma padic_set_zero_res:
assumes "prime p"
assumes "f ∈ (padic_set p)"
shows "f 0 = 0"
proof-
have "f 0 ∈ carrier (residue_ring 1)"
using assms(1) padic_set_res_closed
by (metis assms(2) power_0)
then show ?thesis
using residue_ring_def by simp
qed
lemma padic_set_memI:
fixes f :: "padic_int"
assumes "⋀m. (f m) ∈ (carrier (residue_ring (p^m)))"
assumes "(⋀(m::nat) n. (n > m ⟹ (residue (p^m) (f n) = (f m))))"
shows "f ∈ padic_set (p::int)"
by (simp add: assms(1) assms(2) padic_set_def)
lemma padic_set_memI':
fixes f :: "padic_int"
assumes "⋀m. (f m) ∈ {0..<p^m}"
assumes "⋀(m::nat) n. n > m ⟹ (f n) mod p^m = (f m)"
shows "f ∈ padic_set (p::int)"
apply(rule padic_set_memI)
using assms(1) residue_ring_def apply auto[1]
by (simp add: assms(2) residue_def)
section‹The standard operations on the $p$-adic integers›
subsection‹Addition›
text‹Addition and multiplication are defined componentwise on residue rings:›
definition padic_add :: "int ⇒ padic_int ⇒ padic_int ⇒ padic_int "
where "padic_add p f g ≡ (λ n. (f n) ⊕⇘(residue_ring (p^n))⇙ (g n))"
lemma padic_add_res:
"(padic_add p f g) n = (f n) ⊕⇘(residue_ring (p^n))⇙ (g n)"
by (simp add: padic_add_def)
text‹Definition of the $p$-adic additive unit:›
definition padic_zero :: "int ⇒ padic_int" where
"padic_zero p ≡ (λn. 0)"
lemma padic_zero_simp:
"padic_zero p n = 𝟬⇘residue_ring (p^n)⇙"
"padic_zero p n = 0"
apply (simp add: padic_zero_def residue_ring_def)
using padic_zero_def by auto
lemma padic_zero_in_padic_set:
assumes "p > 0"
shows "padic_zero p ∈ padic_set p"
apply(rule padic_set_memI)
by(auto simp: assms padic_zero_def residue_def residue_ring_def)
text‹$p$-adic additive inverses:›
definition padic_a_inv :: "int ⇒ padic_int ⇒ padic_int" where
"padic_a_inv p f ≡ λ n. ⊖⇘residue_ring (p^n)⇙ (f n)"
lemma padic_a_inv_simp:
"padic_a_inv p f n≡ ⊖⇘residue_ring (p^n)⇙ (f n)"
by (simp add: padic_a_inv_def)
lemma padic_a_inv_simp':
assumes "prime p"
assumes "f ∈ padic_set p"
assumes "n >0"
shows "padic_a_inv p f n = (if n=0 then 0 else (- (f n)) mod (p^n))"
proof-
have "residues (p^n)"
by (simp add: assms(1) assms(3) prime_gt_1_int residues.intro)
then show ?thesis
using residue_ring_def padic_a_inv_def residues.res_neg_eq
by auto
qed
text‹
We show that \<^const>‹padic_set› is closed under additive inverses. Note that we have to treat the
case of residues at $0$ separately.
›
lemma residue_1_prop:
"⊖⇘residue_ring 1⇙ 𝟬⇘residue_ring 1⇙ = 𝟬⇘residue_ring 1⇙"
proof-
let ?x = "𝟬⇘residue_ring 1⇙"
let ?y = "⊖⇘residue_ring 1⇙ 𝟬⇘residue_ring 1⇙"
let ?G = "add_monoid (residue_ring 1)"
have P0:" ?x ⊕⇘residue_ring 1⇙ ?x = ?x"
by (simp add: residue_ring_def)
have P1: "?x ∈ carrier (residue_ring 1)"
by (simp add: residue_ring_def)
have "?x ∈ carrier ?G ∧ ?x ⊗⇘?G⇙ ?x = 𝟭⇘?G⇙ ∧ ?x ⊗⇘?G⇙ ?x = 𝟭⇘?G⇙"
using P0 P1 by auto
then show ?thesis
by (simp add: m_inv_def a_inv_def residue_ring_def)
qed
lemma residue_1_zero:
"residue 1 n = 0"
by (simp add: residue_def)
lemma padic_a_inv_in_padic_set:
assumes "f ∈ padic_set p"
assumes "prime (p::int)"
shows "(padic_a_inv p f) ∈ padic_set p"
proof(rule padic_set_memI)
show "⋀m. padic_a_inv p f m ∈ carrier (residue_ring (p ^ m))"
proof-
fix m
show "padic_a_inv p f m ∈ carrier (residue_ring (p ^ m))"
proof-
have P0: "padic_a_inv p f m = ⊖⇘residue_ring (p^m)⇙ (f m)"
using padic_a_inv_def by simp
then show ?thesis
by (metis (no_types, lifting) assms(1) assms(2) cring.cring_simprules(3) neq0_conv
one_less_power padic_set_res_closed padic_set_zero_res power_0 prime_gt_1_int residue_1_prop
residue_ring_def residues.cring residues.intro ring.simps(1))
qed
qed
show "⋀m n. m < n ⟹ residue (p ^ m) (padic_a_inv p f n) = padic_a_inv p f m"
proof-
fix m n::nat
assume "m < n"
show "residue (p ^ m) (padic_a_inv p f n) = padic_a_inv p f m"
proof(cases "m=0")
case True
then have 0: "residue (p ^ m) (padic_a_inv p f n) = 0" using residue_1_zero
by simp
have "f m = 0"
using assms True padic_set_def residue_ring_def padic_set_zero_res
by auto
then have 1: "padic_a_inv p f m = 0" using residue_1_prop assms
by (simp add: True padic_a_inv_def residue_ring_def)
then show ?thesis using 0 1
by simp
next
case False
have 0: "f n ∈ carrier (residue_ring (p^n)) "
using assms(1) padic_set_res_closed by auto
have 1: "padic_a_inv p f n = ⊖⇘residue_ring (p^n)⇙ (f n)" using padic_a_inv_def
by simp
have 2: "padic_a_inv p f m = ⊖⇘residue_ring (p^m)⇙ (f m)" using False padic_a_inv_def
by simp
have 3: "residue (p ^ m) ∈ ring_hom (residue_ring (p ^ n)) (residue_ring (p ^ m))"
using residue_hom_p False ‹m < n› assms(2) by auto
have 4: " cring (residue_ring (p ^ n))"
using ‹m < n› assms(2) prime_gt_1_int residues.cring residues.intro by auto
have 5: " cring (residue_ring (p ^ m))"
using False assms(2) prime_gt_1_int residues.cring residues.intro by auto
have "ring_hom_cring (residue_ring (p ^ n)) (residue_ring (p ^ m)) (residue (p ^ m))"
using 3 4 5 UnivPoly.ring_hom_cringI by blast
then show ?thesis using 0 1 2 ring_hom_cring.hom_a_inv
by (metis ‹m < n› assms(1) assms(2) less_imp_le_nat padic_set_res_coherent)
qed
qed
qed
subsection‹Multiplication›
definition padic_mult :: "int ⇒ padic_int ⇒ padic_int ⇒ padic_int"
where "padic_mult p f g ≡ (λ n. (f n) ⊗⇘(residue_ring (p^n))⇙ (g n))"
lemma padic_mult_res:
"(padic_mult p f g) n = (f n) ⊗⇘(residue_ring (p^n))⇙ (g n)"
by (simp add: padic_mult_def)
text‹Definition of the $p$-adic multiplicative unit:›
definition padic_one :: "int ⇒ padic_int" where
"padic_one p ≡ (λn.(if n=0 then 0 else 1))"
lemma padic_one_simp:
assumes "n >0"
shows "padic_one p n = 𝟭⇘residue_ring (p^n)⇙"
"padic_one p n = 1"
apply (simp add: assms padic_one_def residue_ring_def)
using assms padic_one_def by auto
lemma padic_one_in_padic_set:
assumes "prime p"
shows "padic_one p ∈ padic_set p"
apply(rule padic_set_memI)
by(auto simp : assms padic_one_def prime_gt_1_int residue_def residue_ring_def)
lemma padic_simps:
"padic_zero p n = 𝟬⇘residue_ring (p^n)⇙"
"padic_a_inv p f n ≡ ⊖⇘residue_ring (p^n)⇙ (f n)"
"(padic_mult p f g) n = (f n) ⊗⇘(residue_ring (p^n))⇙ (g n)"
"(padic_add p f g) n = (f n) ⊕⇘(residue_ring (p^n))⇙ (g n)"
"n>0 ⟹padic_one p n = 𝟭⇘residue_ring (p^n)⇙"
apply (simp add: padic_zero_simp)
apply (simp add: padic_a_inv_simp)
apply (simp add: padic_mult_def)
apply (simp add: padic_add_res)
using padic_one_simp by auto
lemma residue_1_mult:
assumes "x ∈ carrier (residue_ring 1)"
assumes "y ∈ carrier (residue_ring 1)"
shows "x ⊗⇘residue_ring 1⇙ y = 0"
by (simp add: residue_ring_def)
lemma padic_mult_in_padic_set:
assumes "f ∈ (padic_set p)"
assumes "g ∈ (padic_set p)"
assumes "prime p"
shows "(padic_mult p f g)∈ (padic_set p)"
proof(rule padic_set_memI')
show "⋀m. padic_mult p f g m ∈ {0..<p ^ m}"
unfolding padic_mult_def
using assms residue_ring_def
by (simp add: prime_gt_0_int)
show "⋀m n. m < n ⟹ padic_mult p f g n mod p ^ m = padic_mult p f g m"
proof-
fix m n::nat
assume A: "m < n"
then show "padic_mult p f g n mod p ^ m = padic_mult p f g m"
proof(cases "m=0")
case True
then show ?thesis
by (metis assms(1) assms(2) mod_by_1 padic_mult_def padic_set_res_closed power_0 residue_1_mult)
next
case False
have 0:"residue (p ^ m) ∈ ring_hom (residue_ring (p^n)) (residue_ring (p^m))"
using A residue_hom_p assms False by auto
have 1:"f n ∈ carrier (residue_ring (p^n))"
using assms(1) padic_set_res_closed by auto
have 2:"g n ∈ carrier (residue_ring (p^n))"
using assms(2) padic_set_res_closed by auto
have 3: "residue (p^m) (f n ⊗⇘residue_ring (p^n)⇙ g n)
= f m ⊗⇘residue_ring (p^m)⇙ g m"
using "0" "1" "2" A assms(1) assms(2) assms(3) less_imp_le of_nat_power padic_set_res_coherent
by (simp add: assms(2) ring_hom_mult)
then show ?thesis
using ring_hom_mult padic_simps[simp] residue_def
by auto
qed
qed
qed
section‹The $p$-adic Valuation›
text‹This section defines the integer-valued $p$-adic valuation. Maps $0$ to $-1$ for now, otherwise is correct. We want the valuation to be integer-valued, but in practice we know it will always be positive. When we extend the valuation from the $p$-adic integers to the $p$-adic field we will have elements of negative valuation. ›
definition padic_val :: "int ⇒ padic_int ⇒ int" where
"padic_val p f ≡ if (f = padic_zero p) then -1 else int (LEAST k::nat. (f (Suc k)) ≠ 𝟬⇘residue_ring (p^(Suc k))⇙)"
text‹Characterization of $padic\_val$ on nonzero elements›
lemma val_of_nonzero:
assumes "f ∈ padic_set p"
assumes "f ≠ padic_zero p"
assumes "prime p"
shows "f (nat (padic_val p f) + 1) ≠ 𝟬⇘residue_ring (p^((nat (padic_val p f) + 1)))⇙"
"f (nat (padic_val p f)) = 𝟬⇘residue_ring (p^((nat (padic_val p f))))⇙"
"f (nat (padic_val p f) + 1) ≠ 0"
"f (nat (padic_val p f)) = 0"
proof-
let ?vf = "padic_val p f"
have 0: "?vf =int (LEAST k::nat. (f (Suc k)) ≠ 𝟬⇘residue_ring (p^(Suc k))⇙)"
using assms(2) padic_val_def by auto
have 1: "(∃ k::nat. (f (Suc k)) ≠ 𝟬⇘residue_ring (p^(Suc k))⇙)"
proof-
obtain k where 1: "(f k) ≠ (padic_zero p k)"
using assms(2) by (meson ext)
have 2: "k ≠ 0"
proof
assume "k=0"
then have "f k = 0"
using assms padic_set_zero_res by blast
then show False
using padic_zero_def 1 by simp
qed
then obtain m where "k = Suc m"
by (meson lessI less_Suc_eq_0_disj)
then have "(f (Suc m)) ≠ 𝟬⇘residue_ring (p^(Suc m))⇙"
using "1" padic_zero_simp by simp
then show ?thesis
by auto
qed
then have "(f (Suc (nat ?vf))) ≠ 𝟬⇘residue_ring (p^(Suc (nat ?vf)))⇙"
using 0 by (metis (mono_tags, lifting) LeastI_ex nat_int)
then show C0: "f (nat (padic_val p f) + 1) ≠ 𝟬⇘residue_ring (p^((nat (padic_val p f) + 1)))⇙"
using 0 1 by simp
show C1: "f (nat (padic_val p f)) = 𝟬⇘residue_ring (p^((nat (padic_val p f))))⇙"
proof(cases "(padic_val p f) = 0")
case True
then show ?thesis
using assms(1) assms(3) padic_set_zero_res residue_ring_def by auto
next
case False
have "¬ f (nat (padic_val p f)) ≠ 𝟬⇘residue_ring (p ^ nat (padic_val p f))⇙"
proof
assume "f (nat (padic_val p f)) ≠ 𝟬⇘residue_ring (p ^ nat (padic_val p f))⇙"
obtain k where " (Suc k) = (nat (padic_val p f))" using False
using "0" gr0_conv_Suc by auto
then have "?vf ≠ int (LEAST k::nat. (f (Suc k)) ≠ 𝟬⇘residue_ring (p^(Suc k))⇙)"
using False by (metis (mono_tags, lifting) Least_le
‹f (nat (padic_val p f)) ≠ 𝟬⇘residue_ring (p ^ nat (padic_val p f))⇙›
add_le_same_cancel2 nat_int not_one_le_zero plus_1_eq_Suc)
then show False using "0" by blast
qed
then show "f (nat (padic_val p f)) = 𝟬⇘residue_ring (p ^ nat (padic_val p f))⇙" by auto
qed
show "f (nat (padic_val p f) + 1) ≠ 0"
using C0 residue_ring_def
by auto
show "f (nat (padic_val p f)) = 0"
by (simp add: C1 residue_ring_def)
qed
text‹If $x \mod p^{n+1} \neq 0$, then $n \geq val x$.›
lemma below_val_zero:
assumes "prime p"
assumes "x ∈ (padic_set p)"
assumes "x (Suc n) ≠ 𝟬⇘residue_ring (p^(Suc n))⇙"
shows "int n ≥ (padic_val p x )"
proof(cases "x = padic_zero p")
case True
then show ?thesis
using assms(3) padic_zero_simp by blast
next
case False
then have "padic_val p x = int (LEAST k::nat. x (Suc k) ≠ 𝟬⇘residue_ring (p ^ Suc k)⇙)"
using padic_val_def by auto
then show "of_nat n ≥ (padic_val p x )"
by (metis (mono_tags, lifting) Least_le assms(3) nat_int nat_le_iff)
qed
text‹If $n < val x$ then $x \mod p^n = 0$:›
lemma zero_below_val:
assumes "prime p"
assumes "x ∈ padic_set p"
assumes "n ≤ padic_val p x"
shows "x n = 𝟬⇘residue_ring (p^n)⇙"
"x n = 0"
proof-
show "x n = 𝟬⇘residue_ring (p ^ n)⇙"
proof(cases "n=0")
case True
then have "x 0 ∈carrier (residue_ring (p^0))"
using assms(2) padic_set_res_closed by blast
then show ?thesis
by (simp add: True residue_ring_def)
next
case False
show ?thesis
proof(cases "x = padic_zero p")
case True
then show ?thesis
by (simp add: padic_zero_simp)
next
case F: False
then have A: "padic_val p x = int (LEAST k::nat. (x (Suc k)) ≠ 𝟬⇘residue_ring (p^(Suc k))⇙)"
using padic_val_def by auto
have "¬ (x n) ≠ 𝟬⇘residue_ring (p^n)⇙"
proof
assume "(x n) ≠ 𝟬⇘residue_ring (p^n)⇙"
obtain k where "n = Suc k"
using False old.nat.exhaust by auto
then have "k ≥ padic_val p x" using A
using ‹x n ≠ 𝟬⇘residue_ring (p ^ n)⇙› assms(1) assms(2) below_val_zero by blast
then have "n > padic_val p x"
using ‹n = Suc k› by linarith
then show False using assms(3)
by linarith
qed
then show ?thesis
by simp
qed
qed
show "x n = 0"
by (simp add: ‹x n = 𝟬⇘residue_ring (p ^ n)⇙› residue_ring_def)
qed
text‹Zero is the only element with valuation equal to $-1$:›
lemma val_zero:
assumes P: "f ∈ (padic_set p)"
shows "padic_val p f = -1 ⟷ (f = (padic_zero p))"
proof
show "padic_val p f = -1 ⟹ (f = (padic_zero p))"
proof
assume A:"padic_val p f = -1"
fix k
show "f k = padic_zero p k"
proof-
have "f k ≠ padic_zero p k ⟹ False"
proof-
assume A0: " f k ≠ padic_zero p k"
have False
proof-
have "f 0 ∈ carrier (residue_ring 1)" using P padic_set_def
by (metis (no_types, lifting) mem_Collect_eq power_0)
then have "f 0 = 𝟬⇘residue_ring (p^0)⇙"
by (simp add: residue_ring_def)
then have "k>0"
using A0 gr0I padic_zero_def
by (metis padic_zero_simp)
then have "(LEAST k. 0 < k ∧ f (Suc k) ≠ padic_zero p (Suc k)) ≥0 "
by simp
then have "padic_val p f ≥0"
using A0 padic_val_def by auto
then show ?thesis using A0 by (simp add: A)
qed
then show ?thesis by blast
qed
then show ?thesis
by blast
qed
qed
assume B: "f = padic_zero p"
then show "padic_val p f = -1"
using padic_val_def by simp
qed
text‹
The valuation turns multiplication into integer addition on nonzero elements. Note that this i
the first instance where we need to explicity use the fact that $p$ is a prime.
›
lemma val_prod:
assumes "prime p"
assumes "f ∈ (padic_set p)"
assumes "g ∈ (padic_set p)"
assumes "f ≠ padic_zero p"
assumes "g ≠ padic_zero p"
shows "padic_val p (padic_mult p f g) = padic_val p f + padic_val p g"
proof-
let ?vp = "padic_val p (padic_mult p f g)"
let ?vf = "padic_val p f"
let ?vg = "padic_val p g"
have 0: "f (nat ?vf + 1) ≠ 𝟬⇘residue_ring (p^(nat ?vf + 1))⇙"
using assms(2) assms(4) val_of_nonzero assms(1) by blast
have 1: "g (nat ?vg + 1) ≠ 𝟬⇘residue_ring (p^(nat ?vg + 1))⇙"
using assms(3) assms(5) val_of_nonzero assms(1) by blast
have 2: "f (nat ?vf) = 𝟬⇘residue_ring (p^(nat ?vf))⇙"
using assms(1) assms(2) assms(4) val_of_nonzero(2) by blast
have 3: "g (nat ?vg) = 𝟬⇘residue_ring (p^(nat ?vg))⇙"
using assms(1) assms(3) assms(5) val_of_nonzero(2) by blast
let ?nm = "((padic_mult p f g) (Suc (nat (?vf + ?vg))))"
let ?n = "(f (Suc (nat (?vf + ?vg))))"
let ?m = "(g (Suc (nat (?vf + ?vg))))"
have A: "?nm = ?n ⊗⇘residue_ring (p^((Suc (nat (?vf + ?vg))))) ⇙ ?m"
using padic_mult_def by simp
have 5: "f (nat ?vf + 1) = residue (p^(nat ?vf + 1)) ?n"
proof-
have "(Suc (nat (?vf + ?vg))) ≥ (nat ?vf + 1)"
by (simp add: assms(5) padic_val_def)
then have "f (nat ?vf + 1) = residue (p^(nat ?vf + 1)) (f (Suc (nat (?vf + ?vg))))"
using assms(1) assms(2) padic_set_res_coherent by presburger
then show ?thesis by auto
qed
have 6: "f (nat ?vf) = residue (p^(nat ?vf)) ?n"
using add.commute assms(1) assms(2) assms(5) int_nat_eq nat_int
nat_le_iff not_less_eq_eq padic_set_res_coherent padic_val_def plus_1_eq_Suc by auto
have 7: "g (nat ?vg + 1) = residue (p^(nat ?vg + 1)) ?m"
proof-
have "(Suc (nat (?vf + ?vg))) ≥ (nat ?vg + 1)"
by (simp add: assms(4) padic_val_def)
then have "g (nat ?vg + 1) = residue (p^(nat ?vg + 1)) (g (Suc (nat (?vf + ?vg))))"
using assms(1) assms(3) padic_set_res_coherent by presburger
then show ?thesis by auto
qed
have 8: "g (nat ?vg) = residue (p^(nat ?vg)) ?m"
proof-
have "(Suc (nat (?vf + ?vg))) ≥ (nat ?vg)"
by (simp add: assms(4) padic_val_def)
then have "g (nat ?vg) = residue (p^(nat ?vg)) (g (Suc (nat (?vf + ?vg))))"
using assms(1) assms(3) padic_set_res_coherent by presburger
then show ?thesis by auto
qed
have 9: "f (nat ?vf) = 0"
by (simp add: "2" residue_ring_def)
have 10: "g (nat ?vg) = 0"
by (simp add: "3" residue_ring_def)
have 11: "f (nat ?vf + 1) ≠ 0"
using "0" residue_ring_def by auto
have 12: "g (nat ?vg + 1) ≠0"
using "1" residue_ring_def by auto
have 13:"∃i. ?n = i*p^(nat ?vf) ∧ ¬ p dvd (nat i)"
proof-
have "residue (p^(nat ?vf)) (?n) = f (nat ?vf)"
by (simp add: "6")
then have P0: "residue (p^(nat ?vf)) (?n) = 0"
using "9" by linarith
have "residue (p^(nat ?vf + 1)) (?n) = f (nat ?vf + 1)"
using "5" by linarith
then have P1: "residue (p^(nat ?vf + 1)) (?n) ≠ 0"
using "11" by linarith
have P2: "?n mod (p^(nat ?vf)) = 0"
using P0 residue_def by auto
have P3: "?n mod (p^(nat ?vf + 1)) ≠ 0"
using P1 residue_def by auto
have "p^(nat ?vf) dvd ?n"
using P2 by auto
then obtain i where A0:"?n = i*(p^(nat ?vf))"
by fastforce
have "?n ∈ carrier (residue_ring (p^(Suc (nat (?vf + ?vg)))))"
using assms(2) padic_set_res_closed by blast
then have "?n ≥0"
by (simp add: residue_ring_def)
then have NN:"i ≥ 0"
proof-
have S0:"?n ≥0"
using ‹0 ≤ f (Suc (nat (padic_val p f + padic_val p g)))› by blast
have S1:"(p^(nat ?vf)) > 0"
using assms(1) prime_gt_0_int zero_less_power by blast
have "¬ i<0"
proof
assume "i < 0"
then have "?n < 0"
using S1 A0 by (metis mult.commute times_int_code(1) zmult_zless_mono2)
then show False
using S0 by linarith
qed
then show ?thesis by auto
qed
have A1: "¬ p dvd (nat i)"
proof
assume "p dvd nat i"
then obtain j where "nat i = j*p"
by fastforce
then have "?n = j*p*(p^(nat ?vf))" using A0 NN
by simp
then show False
using P3 by auto
qed
then show ?thesis
using A0 by blast
qed
have 14:"∃ i. ?m = i*p^(nat ?vg) ∧ ¬ p dvd (nat i)"
proof-
have "residue (p^(nat ?vg)) (?m) = g (nat ?vg)"
by (simp add: "8")
then have P0: "residue (p^(nat ?vg)) (?m) = 0"
using "10" by linarith
have "residue (p^(nat ?vg + 1)) (?m) = g (nat ?vg + 1)"
using "7" by auto
then have P1: "residue (p^(nat ?vg + 1)) (?m) ≠ 0"
using "12" by linarith
have P2: "?m mod (p^(nat ?vg)) = 0"
using P0 residue_def by auto
have P3: "?m mod (p^(nat ?vg + 1)) ≠ 0"
using P1 residue_def by auto
have "p^(nat ?vg) dvd ?m"
using P2 by auto
then obtain i where A0:"?m = i*(p^(nat ?vg))"
by fastforce
have "?m ∈ carrier (residue_ring (p^(Suc (nat (?vf + ?vg)))))"
using assms(3) padic_set_res_closed by blast
then have S0: "?m ≥0"
by (simp add: residue_ring_def)
then have NN:"i ≥ 0"
using 0 assms(1) prime_gt_0_int[of p] zero_le_mult_iff zero_less_power[of p]
by (metis A0 linorder_not_less)
have A1: "¬ p dvd (nat i)"
proof
assume "p dvd nat i"
then obtain j where "nat i = j*p"
by fastforce
then have "?m = j*p*(p^(nat ?vg))" using A0 NN
by (metis int_nat_eq )
then show False
using P3 by auto
qed
then show ?thesis
by (metis (no_types, lifting) A0)
qed
obtain i where I:"?n = i*p^(nat ?vf) ∧ ¬ p dvd (nat i)"
using "13" by blast
obtain j where J:"?m = j*p^(nat ?vg) ∧ ¬ p dvd (nat j)"
using "14" by blast
let ?i = "(p^(Suc (nat (?vf + ?vg))))"
have P:"?nm mod ?i = ?n*?m mod ?i"
proof-
have P1:"?nm = (?n ⊗⇘residue_ring ?i ⇙ ?m)"
using A by simp
have P2:"(?n ⊗⇘residue_ring ?i ⇙ ?m) = (residue ?i (?n)) ⊗⇘residue_ring ?i⇙ (residue ?i (?m))"
using assms(1) assms(2) assms(3) padic_set_res_closed prime_ge_0_int residue_id by presburger
then have P3:"(?n ⊗⇘residue_ring ?i ⇙ ?m) = (residue ?i (?n*?m))"
by (metis monoid.simps(1) residue_def residue_ring_def)
then show ?thesis
by (simp add: P1 residue_def)
qed
then have 15: "?nm mod ?i = i*j*p^((nat ?vf) +(nat ?vg)) mod ?i"
by (simp add: I J mult.assoc mult.left_commute power_add)
have 16: "¬ p dvd (i*j)" using 13 14
using I J assms(1) prime_dvd_mult_iff
by (metis dvd_0_right int_nat_eq)
have 17: "((nat ?vf) +(nat ?vg)) < (Suc (nat (?vf + ?vg)))"
by (simp add: assms(4) assms(5) nat_add_distrib padic_val_def)
have 18:"?nm mod ?i ≠0"
proof-
have A0:"¬ p^((Suc (nat (?vf + ?vg)))) dvd p^((nat ?vf) +(nat ?vg)) "
using 17
by (metis "16" assms(1) dvd_power_iff dvd_trans less_int_code(1) linorder_not_less one_dvd prime_gt_0_int)
then have A1: "p^((nat ?vf) +(nat ?vg)) mod ?i ≠ 0"
using dvd_eq_mod_eq_0
by auto
have "¬ p^((Suc (nat (?vf + ?vg)))) dvd i*j*p^((nat ?vf) +(nat ?vg)) "
using 16 A0 assms(1) assms(4) assms(5) nat_int_add padic_val_def by auto
then show ?thesis
using "15" by force
qed
have 19: "(?nm mod ?i ) mod (p^(nat ?vf + nat ?vg)) = i*j*p^((nat ?vf) +(nat ?vg)) mod (p^(nat ?vf + nat ?vg))"
using 15 by (simp add: assms(4) assms(5) nat_add_distrib padic_val_def)
have 20: "?nm mod (p^(nat ?vf + nat ?vg)) = 0"
proof-
have "(?nm mod ?i ) mod (p^(nat ?vf + nat ?vg)) = 0"
using 19
by simp
then show ?thesis
using "17" assms(1) int_nat_eq mod_mod_cancel[of "p^(nat ?vf + nat ?vg)" ?i]
mod_pos_pos_trivial
by (metis le_imp_power_dvd less_imp_le_nat)
qed
have 21: "(padic_mult p f g) ≠ padic_zero p"
proof
assume "(padic_mult p f g) = padic_zero p"
then have "(padic_mult p f g) (Suc (nat (padic_val p f + padic_val p g))) = padic_zero p (Suc (nat (padic_val p f + padic_val p g)))"
by simp
then have "?nm = (padic_zero p (Suc (nat (padic_val p f + padic_val p g))))"
by blast
then have "?nm = 0"
by (simp add: padic_zero_def)
then show False
using "18" by auto
qed
have 22: "(padic_mult p f g)∈ (padic_set p)"
using assms(1) assms(2) assms(3) padic_mult_in_padic_set by blast
have 23: "⋀ j. j < Suc (nat (padic_val p f + padic_val p g)) ⟹ (padic_mult p f g) j = 𝟬⇘residue_ring (p^j)⇙"
proof-
fix k
let ?j = "Suc (nat (padic_val p f + padic_val p g))"
assume P: "k < ?j"
show "(padic_mult p f g) k = 𝟬⇘residue_ring (p^k)⇙"
proof-
have P0: "(padic_mult p f g) (nat ?vf + nat ?vg) = 𝟬⇘residue_ring (p^(nat ?vf + nat ?vg))⇙"
proof-
let ?k = "(nat ?vf + nat ?vg)"
have "((padic_mult p f g) ?k) = residue (p^?k) ((padic_mult p f g) ?k) "
using P 22 padic_set_res_coherent by (simp add: assms(1) prime_gt_0_nat)
then have "((padic_mult p f g) ?k) = residue (p^?k) ?nm"
using "17" "22" assms(1) padic_set_res_coherent by fastforce
then have "((padic_mult p f g) ?k) = residue (p^?k) ?nm"
by (simp add: residue_def)
then have "((padic_mult p f g) ?k) = residue (p^?k) 0"
using "20" residue_def by auto
then show ?thesis
by (simp add: residue_def residue_ring_def)
qed
then show ?thesis
proof(cases "k = (nat ?vf + nat ?vg)")
case True then show ?thesis
using P0 by blast
next
case B: False
then show ?thesis
proof(cases "k=0")
case True
then show ?thesis
using "22" assms(1) padic_set_zero_res residue_ring_def by auto
next
case C: False
then have "((padic_mult p f g) k) = residue (p^k) ((padic_mult p f g) (nat ?vf + nat ?vg)) "
using B P 22 padic_set_res_coherent by (simp add: assms(1) assms(4) assms(5) padic_val_def prime_gt_0_nat)
then have S: "((padic_mult p f g) k) = residue (p^k) 𝟬⇘residue_ring (p^((nat ?vf + nat ?vg)))⇙"
by (simp add: P0)
have "residue (p^k) ∈ ring_hom (residue_ring (p^((nat ?vf + nat ?vg)))) (residue_ring (p^k))"
using B P C residue_hom_p
using assms(1) assms(4) assms(5) less_Suc0 nat_int not_less_eq of_nat_power padic_val_def prime_nat_int_transfer by auto
then show ?thesis using S
using P0 padic_zero_def padic_zero_simp residue_def by auto
qed
qed
qed
qed
have 24: "(padic_mult p f g) (Suc (nat ?vf + nat ?vg)) ≠ 𝟬⇘residue_ring ((p ^ Suc (nat (padic_val p f + padic_val p g))))⇙"
by (metis (no_types, lifting) "18" A P assms(4) assms(5) monoid.simps(1) nat_int nat_int_add padic_val_def residue_ring_def ring.simps(1))
have 25: "padic_val p (padic_mult p f g) = int (LEAST k::nat. ((padic_mult p f g) (Suc k)) ≠ 𝟬⇘residue_ring (p^(Suc k))⇙)"
using padic_val_def 21 by auto
have 26:"(nat (padic_val p f + padic_val p g)) ∈ {k::nat. ((padic_mult p f g) (Suc k)) ≠ 𝟬⇘residue_ring (p^(Suc k))⇙}" using 24
using "18" assms(1) prime_gt_0_nat
by (metis (mono_tags, lifting) mem_Collect_eq mod_0 residue_ring_def ring.simps(1))
have 27: "⋀ j. j < (nat (padic_val p f + padic_val p g)) ⟹
j ∉ {k::nat. ((padic_mult p f g) (Suc k)) ≠ 𝟬⇘residue_ring (p^(Suc k))⇙}"
by (simp add: "23")
have "(nat (padic_val p f + padic_val p g)) = (LEAST k::nat. ((padic_mult p f g) (Suc k)) ≠ 𝟬⇘residue_ring (p^(Suc k))⇙) "
proof-
obtain P where C0: "P= (λ k. ((padic_mult p f g) (Suc k)) ≠ 𝟬⇘residue_ring (p^(Suc k))⇙)"
by simp
obtain x where C1: "x = (nat (padic_val p f + padic_val p g))"
by blast
have C2: "P x"
using "26" C0 C1 by blast
have C3:"⋀ j. j< x ⟹ ¬ P j"
using C0 C1 by (simp add: "23")
have C4: "⋀ j. P j ⟹ x ≤j"
using C3 le_less_linear by blast
have "x = (LEAST k. P k)"
using C2 C4 Least_equality by auto
then show ?thesis using C0 C1 by auto
qed
then have "padic_val p (padic_mult p f g) = (nat (padic_val p f + padic_val p g))"
using "25" by linarith
then show ?thesis
by (simp add: assms(4) assms(5) padic_val_def)
qed
section‹Defining the Ring of $p$-adic Integers:›
definition padic_int :: "int ⇒ padic_int ring"
where "padic_int p ≡ ⦇carrier = (padic_set p),
Group.monoid.mult = (padic_mult p), one = (padic_one p),
zero = (padic_zero p), add = (padic_add p)⦈"
lemma padic_int_simps:
"𝟭⇘padic_int p⇙ = padic_one p"
"𝟬⇘padic_int p⇙ = padic_zero p"
"(⊕⇘padic_int p⇙) = padic_add p"
"(⊗⇘padic_int p⇙) = padic_mult p"
"carrier (padic_int p) = padic_set p"
unfolding padic_int_def by auto
lemma residues_n:
assumes "n ≠ 0"
assumes "prime p"
shows "residues (p^n)"
proof
have "p > 1" using assms(2)
using prime_gt_1_int by auto
then show " 1 < p ^ n "
using assms(1) by auto
qed
text‹$p$-adic multiplication is associative›
lemma padic_mult_assoc:
assumes "prime p"
shows "⋀x y z.
x ∈ carrier (padic_int p) ⟹
y ∈ carrier (padic_int p) ⟹
z ∈ carrier (padic_int p) ⟹
x ⊗⇘padic_int p⇙ y ⊗⇘padic_int p⇙ z = x ⊗⇘padic_int p⇙ (y ⊗⇘padic_int p⇙ z)"
proof-
fix x y z
assume Ax: " x ∈ carrier (padic_int p)"
assume Ay: " y ∈ carrier (padic_int p)"
assume Az: " z ∈ carrier (padic_int p)"
show "x ⊗⇘padic_int p⇙ y ⊗⇘padic_int p⇙ z = x ⊗⇘padic_int p⇙ (y ⊗⇘padic_int p⇙ z)"
proof
fix n
show "((x ⊗⇘padic_int p⇙ y) ⊗⇘padic_int p⇙ z) n = (x ⊗⇘padic_int p⇙ (y ⊗⇘padic_int p⇙ z)) n"
proof(cases "n=0")
case True
then show ?thesis using padic_int_simps
by (metis Ax Ay Az assms padic_mult_in_padic_set padic_set_zero_res)
next
case False
then have "residues (p^n)"
by (simp add: assms residues_n)
then show ?thesis
using residues.cring padic_set_res_closed padic_mult_in_padic_set Ax Ay Az padic_mult_res
by (simp add: cring.cring_simprules(11) padic_int_def)
qed
qed
qed
text‹The $p$-adic integers are closed under addition:›
lemma padic_add_closed:
assumes "prime p"
shows "⋀x y.
x ∈ carrier (padic_int p) ⟹
y ∈ carrier (padic_int p) ⟹
x ⊕⇘(padic_int p)⇙ y ∈ carrier (padic_int p)"
proof
fix x::"padic_int"
fix y::"padic_int"
assume Px: "x ∈carrier (padic_int p) "
assume Py: "y ∈carrier (padic_int p)"
show "x ⊕⇘(padic_int p)⇙ y ∈ carrier (padic_int p)"
proof-
let ?f = "x ⊕⇘(padic_int p)⇙ y"
have 0: "(∀(m::nat). (?f m) ∈ (carrier (residue_ring (p^m))))"
proof fix m
have A1 : "?f m = (x m) ⊕⇘(residue_ring (p^m))⇙ (y m)"
by (simp add: padic_int_def padic_add_def)
have A2: "(x m) ∈(carrier (residue_ring (p^m)))"
using Px by (simp add: padic_int_def padic_set_def)
have A3: "(y m) ∈(carrier (residue_ring (p^m)))"
using Py by (simp add: padic_int_def padic_set_def)
then show "(?f m) ∈ (carrier (residue_ring (p^m)))"
using A1 assms of_nat_0_less_iff prime_gt_0_nat residue_ring_def by force
qed
have 1: "(∀(n::nat) (m::nat). (n > m ⟶ (residue (p^m) (?f n) = (?f m))))"
proof
fix n::nat
show "(∀(m::nat). (n > m ⟶ (residue (p^m) (?f n) = (?f m))))"
proof
fix m::nat
show "(n > m ⟶ (residue (p^m) (?f n) = (?f m)))"
proof
assume A: "m < n"
show "(residue (p^m) (?f n) = (?f m))"
proof(cases "m = 0")
case True
then have A0: "(residue (p^m) (?f n)) = 0"
by (simp add: residue_1_zero)
have A1: "?f m = 0" using True
by (simp add: padic_add_res padic_int_simps(3) residue_ring_def)
then show ?thesis
using A0 by linarith
next
case False
then have "m ≠0" using A by linarith
have D: "p^n mod p^m = 0" using A
by (simp add: le_imp_power_dvd)
let ?LHS = "residue (p ^ m) ((x ⊕⇘padic_int p⇙ y) n)"
have A0: "?LHS = residue (p ^ m) ((x n)⊕⇘residue_ring (p^n)⇙( y n))"
by (simp add: padic_int_def padic_add_def)
have "residue (p^m) ∈ ring_hom (residue_ring ((p^n))) (residue_ring ((p^m)))"
using A False assms residue_hom_p by auto
then have "residue (p ^ m) ((x n)⊕⇘residue_ring (p^n)⇙( y n)) = (residue (p ^ m) (x n))⊕⇘residue_ring (p^m)⇙((residue (p ^ m) (y n)))"
by (metis (no_types, lifting) padic_int_simps(5) Px Py mem_Collect_eq padic_set_def ring_hom_add)
then have "?LHS =(residue (p ^ m) (x n))⊕⇘residue_ring (p^m)⇙((residue (p ^ m) (y n)))"
using A0 by force
then show ?thesis
using A Px Py padic_set_def by (simp add: padic_int_def padic_add_def)
qed
qed
qed
qed
then show ?thesis
using "0" padic_set_memI padic_int_simps by auto
qed
then have " x ⊕⇘padic_int p⇙ y ∈ (padic_set p)"
by(simp add: padic_int_def)
then show "carrier (padic_int p) ⊆ carrier (padic_int p)"
by blast
qed
text‹$p$-adic addition is associative:›
lemma padic_add_assoc:
assumes "prime p"
shows " ⋀x y z.
x ∈ carrier (padic_int p) ⟹
y ∈ carrier (padic_int p) ⟹ z ∈ carrier (padic_int p)
⟹ x ⊕⇘padic_int p⇙ y ⊕⇘padic_int p⇙ z = x ⊕⇘padic_int p⇙ (y ⊕⇘padic_int p⇙ z)"
proof-
fix x y z
assume Ax: "x ∈ carrier (padic_int p)"
assume Ay: "y ∈ carrier (padic_int p)"
assume Az: "z ∈ carrier (padic_int p)"
show " (x ⊕⇘padic_int p⇙ y) ⊕⇘padic_int p⇙ z = x ⊕⇘padic_int p⇙ (y ⊕⇘padic_int p⇙ z)"
proof
fix n
show "((x ⊕⇘padic_int p⇙ y) ⊕⇘padic_int p⇙ z) n = (x ⊕⇘padic_int p⇙ (y ⊕⇘padic_int p⇙ z)) n "
proof-
have Ex: "(x n) ∈ carrier (residue_ring (p^n))"
using Ax padic_set_def padic_int_simps by auto
have Ey: "(y n) ∈ carrier (residue_ring (p^n))"
using Ay padic_set_def padic_int_simps by auto
have Ez: "(z n) ∈ carrier (residue_ring (p^n))"
using Az padic_set_def padic_int_simps by auto
let ?x = "(x n)"
let ?y = "(y n)"
let ?z = "(z n)"
have P1: "(?x ⊕⇘residue_ring (p^n)⇙ ?y) ⊕⇘residue_ring (p^n)⇙ ?z = (x n) ⊕⇘residue_ring (p^n)⇙ ((y ⊕⇘padic_int p⇙ z) n)"
proof(cases "n = 0")
case True
then show ?thesis
by (simp add: residue_ring_def)
next
case False
then have "residues (p^n)"
by (simp add: assms residues_n)
then show ?thesis
using Ex Ey Ez cring.cring_simprules(7) padic_add_res residues.cring padic_int_simps
by fastforce
qed
have " ((y n)) ⊕⇘residue_ring (p^n)⇙ z n =((y ⊕⇘padic_int p⇙ z) n)"
using padic_add_def padic_int_simps by simp
then have P0: "(x n) ⊕⇘residue_ring (p^n)⇙ ((y ⊕⇘padic_int p⇙ z) n) = ((x n) ⊕⇘residue_ring (p^n)⇙ ((y n) ⊕⇘residue_ring (p^n)⇙ z n))"
using padic_add_def padic_int_simps by simp
have "((x ⊕⇘padic_int p⇙ y) ⊕⇘padic_int p⇙ z) n = ((x ⊕⇘padic_int p⇙ y) n) ⊕⇘residue_ring (p^n)⇙ z n"
using padic_add_def padic_int_simps by simp
then have "((x ⊕⇘padic_int p⇙ y) ⊕⇘padic_int p⇙ z) n =((x n) ⊕⇘residue_ring (p^n)⇙ (y n)) ⊕⇘residue_ring (p^n)⇙ z n"
using padic_add_def padic_int_simps by simp
then have "((x ⊕⇘padic_int p⇙ y) ⊕⇘padic_int p⇙ z) n =((x n) ⊕⇘residue_ring (p^n)⇙ ((y n) ⊕⇘residue_ring (p^n)⇙ z n))"
using Ex Ey Ez P1 P0 by linarith
then have "((x ⊕⇘padic_int p⇙ y) ⊕⇘padic_int p⇙ z) n = (x n) ⊕⇘residue_ring (p^n)⇙ ((y ⊕⇘padic_int p⇙ z) n)"
using P0 by linarith
then show ?thesis by (simp add: padic_int_def padic_add_def)
qed
qed
qed
text‹$p$-adic addition is commutative:›
lemma padic_add_comm:
assumes "prime p"
shows " ⋀x y.
x ∈ carrier (padic_int p) ⟹
y ∈ carrier (padic_int p) ⟹
x ⊕⇘padic_int p⇙ y = y ⊕⇘padic_int p⇙ x"
proof-
fix x y
assume Ax: "x ∈ carrier (padic_int p)" assume Ay:"y ∈ carrier (padic_int p)"
show "x ⊕⇘padic_int p⇙ y = y ⊕⇘padic_int p⇙ x"
proof fix n
show "(x ⊕⇘padic_int p⇙ y) n = (y ⊕⇘padic_int p⇙ x) n "
proof(cases "n=0")
case True
then show ?thesis
by (metis Ax Ay assms padic_add_def padic_set_zero_res padic_int_simps(3,5))
next
case False
have LHS0: "(x ⊕⇘padic_int p⇙ y) n = (x n) ⊕⇘residue_ring (p^n)⇙ (y n)"
by (simp add: padic_int_simps padic_add_res)
have RHS0: "(y ⊕⇘padic_int p⇙ x) n = (y n) ⊕⇘residue_ring (p^n)⇙ (x n)"
by (simp add: padic_int_simps padic_add_res)
have Ex: "(x n) ∈ carrier (residue_ring (p^n))"
using Ax padic_set_res_closed padic_int_simps by auto
have Ey: "(y n) ∈ carrier (residue_ring (p^n))"
using Ay padic_set_res_closed padic_int_simps by auto
have LHS1: "(x ⊕⇘padic_int p⇙ y) n = ((x n) +(y n)) mod (p^n)"
using LHS0 residue_ring_def by simp
have RHS1: "(y ⊕⇘padic_int p⇙ x) n = ((y n) +(x n)) mod (p^n)"
using RHS0 residue_ring_def by simp
then show ?thesis using LHS1 RHS1 by presburger
qed
qed
qed
text‹$padic\_zero$ is an additive identity:›
lemma padic_add_zero:
assumes "prime p"
shows "⋀x. x ∈ carrier (padic_int p) ⟹ 𝟬⇘padic_int p⇙ ⊕⇘padic_int p⇙ x = x"
proof-
fix x
assume Ax: "x ∈ carrier (padic_int p)"
show " 𝟬⇘padic_int p⇙ ⊕⇘padic_int p⇙ x = x "
proof fix n
have A: "(padic_zero p) n = 0"
by (simp add: padic_zero_def)
have "((padic_zero p) ⊕⇘padic_int p⇙ x) n = x n"
using Ax padic_int_simps(5) padic_set_res_closed residue_ring_def
by(auto simp add: padic_zero_def padic_int_simps padic_add_res residue_ring_def)
then show "(𝟬⇘padic_int p⇙ ⊕⇘padic_int p⇙ x) n = x n"
by (simp add: padic_int_def)
qed
qed
text‹Closure under additive inverses:›
lemma padic_add_inv:
assumes "prime p"
shows "⋀x. x ∈ carrier (padic_int p) ⟹
∃y∈carrier (padic_int p). y ⊕⇘padic_int p⇙ x = 𝟬⇘padic_int p⇙"
proof-
fix x
assume Ax: " x ∈ carrier (padic_int p)"
show "∃y∈carrier (padic_int p). y ⊕⇘padic_int p⇙ x = 𝟬⇘padic_int p⇙"
proof
let ?y = "(padic_a_inv p) x"
show "?y ⊕⇘padic_int p⇙ x = 𝟬⇘padic_int p⇙"
proof
fix n
show "(?y ⊕⇘padic_int p⇙ x) n = 𝟬⇘padic_int p⇙ n"
proof(cases "n=0")
case True
then show ?thesis
using Ax assms padic_add_closed padic_set_zero_res
padic_a_inv_in_padic_set padic_zero_def padic_int_simps by auto
next
case False
have C: "(x n) ∈ carrier (residue_ring (p^n))"
using Ax padic_set_res_closed padic_int_simps by auto
have R: "residues (p^n)"
using False by (simp add: assms residues_n)
have "(?y ⊕⇘padic_int p⇙ x) n = (?y n) ⊕⇘residue_ring (p^n)⇙ x n"
by (simp add: padic_int_def padic_add_res)
then have "(?y ⊕⇘padic_int p⇙ x) n = 0"
using C R residue_ring_def[simp] residues.cring
by (metis (no_types, lifting) cring.cring_simprules(9) padic_a_inv_def residues.zero_cong)
then show ?thesis
by (simp add: padic_int_def padic_zero_def)
qed
qed
then show "padic_a_inv p x ∈ carrier (padic_int p)"
using padic_a_inv_in_padic_set padic_int_simps
Ax assms prime_gt_0_nat by auto
qed
qed
text‹The ring of padic integers forms an abelian group under addition:›
lemma padic_is_abelian_group:
assumes "prime p"
shows "abelian_group (padic_int p)"
proof (rule abelian_groupI)
show 0: "⋀x y. x ∈ carrier (padic_int p) ⟹
y ∈ carrier (padic_int p) ⟹
x ⊕⇘(padic_int p)⇙ y ∈ carrier (padic_int p)"
using padic_add_closed by (simp add: assms)
show zero: "𝟬⇘padic_int p⇙ ∈ carrier (padic_int p)"
by (metis "0" assms padic_add_inv padic_int_simps(5) padic_one_in_padic_set)
show add_assoc: " ⋀x y z.
x ∈ carrier (padic_int p) ⟹
y ∈ carrier (padic_int p) ⟹
z ∈ carrier (padic_int p) ⟹
x ⊕⇘padic_int p⇙ y ⊕⇘padic_int p⇙ z
= x ⊕⇘padic_int p⇙ (y ⊕⇘padic_int p⇙ z)"
using assms padic_add_assoc by auto
show comm: " ⋀x y.
x ∈ carrier (padic_int p) ⟹
y ∈ carrier (padic_int p) ⟹
x ⊕⇘padic_int p⇙ y = y ⊕⇘padic_int p⇙ x"
using assms padic_add_comm by blast
show "⋀x. x ∈ carrier (padic_int p) ⟹ 𝟬⇘padic_int p⇙ ⊕⇘padic_int p⇙ x = x"
using assms padic_add_zero by blast
show "⋀x. x ∈ carrier (padic_int p) ⟹
∃y∈carrier (padic_int p). y ⊕⇘padic_int p⇙ x = 𝟬⇘padic_int p⇙"
using assms padic_add_inv by blast
qed
text‹One is a multiplicative identity:›
lemma padic_one_id:
assumes "prime p"
assumes "x ∈ carrier (padic_int p)"
shows "𝟭⇘padic_int p⇙ ⊗⇘padic_int p⇙ x = x"
proof
fix n
show "(𝟭⇘padic_int p⇙ ⊗⇘padic_int p⇙ x) n = x n "
proof(cases "n=0")
case True
then show ?thesis
by (metis padic_int_simps(1,4,5) assms(1) assms(2) padic_mult_in_padic_set padic_one_in_padic_set padic_set_zero_res)
next
case False
then have "residues (p^n)"
by (simp add: assms(1) residues_n)
then show ?thesis
using False assms(2) cring.cring_simprules(12) padic_int_simps
padic_mult_res padic_one_simp padic_set_res_closed residues.cring by fastforce
qed
qed
text‹$p$-adic multiplication is commutative:›
lemma padic_mult_comm:
assumes "prime p"
assumes "x ∈ carrier (padic_int p)"
assumes "y ∈ carrier (padic_int p)"
shows "x ⊗⇘padic_int p⇙ y = y ⊗⇘padic_int p⇙ x"
proof
fix n
have Ax: "(x n) ∈ carrier (residue_ring (p^n))"
using padic_set_def assms(2) padic_int_simps by auto
have Ay: "(y n) ∈carrier (residue_ring (p^n))"
using padic_set_def assms(3) padic_set_res_closed padic_int_simps
by blast
show "(x ⊗⇘padic_int p⇙ y) n = (y ⊗⇘padic_int p⇙ x) n"
proof(cases "n=0")
case True
then show ?thesis
by (metis padic_int_simps(4,5) assms(1) assms(2) assms(3) padic_set_zero_res padic_simps(3))
next
case False
have LHS0: "(x ⊗⇘padic_int p⇙ y) n = (x n) ⊗⇘residue_ring (p^n)⇙ (y n)"
by (simp add: padic_int_def padic_mult_res)
have RHS0: "(y ⊗⇘padic_int p⇙ x) n = (y n) ⊗⇘residue_ring (p^n)⇙ (x n)"
by (simp add: padic_int_def padic_mult_res)
have Ex: "(x n) ∈ carrier (residue_ring (p^n))"
using Ax padic_set_res_closed by auto
have Ey: "(y n) ∈ carrier (residue_ring (p^n))"
using Ay padic_set_res_closed by auto
have LHS1: "(x ⊗⇘padic_int p⇙ y) n = ((x n) *(y n)) mod (p^n)"
using LHS0
by (simp add: residue_ring_def)
have RHS1: "(y ⊗⇘padic_int p⇙ x) n = ((y n) *(x n)) mod (p^n)"
using RHS0
by (simp add: residue_ring_def)
then show ?thesis using LHS1 RHS1
by (simp add: mult.commute)
qed
qed
lemma padic_is_comm_monoid:
assumes "prime p"
shows "Group.comm_monoid (padic_int p)"
proof(rule comm_monoidI)
show "⋀x y.
x ∈ carrier (padic_int p) ⟹
y ∈ carrier (padic_int p) ⟹
x ⊗⇘padic_int p⇙ y ∈ carrier (padic_int p)"
by (simp add: padic_int_def assms padic_mult_in_padic_set)
show "𝟭⇘padic_int p⇙ ∈ carrier (padic_int p)"
by (metis padic_int_simps(1,5) assms padic_one_in_padic_set)
show "⋀x y z.
x ∈ carrier (padic_int p) ⟹
y ∈ carrier (padic_int p) ⟹
z ∈ carrier (padic_int p) ⟹
x ⊗⇘padic_int p⇙ y ⊗⇘padic_int p⇙ z = x ⊗⇘padic_int p⇙ (y ⊗⇘padic_int p⇙ z)"
using assms padic_mult_assoc by auto
show "⋀x. x ∈ carrier (padic_int p) ⟹ 𝟭⇘padic_int p⇙ ⊗⇘padic_int p⇙ x = x"
using assms padic_one_id by blast
show "⋀x y.
x ∈ carrier (padic_int p) ⟹
y ∈ carrier (padic_int p) ⟹
x ⊗⇘padic_int p⇙ y = y ⊗⇘padic_int p⇙ x"
using padic_mult_comm by (simp add: assms)
qed
lemma padic_int_is_cring:
assumes "prime p"
shows "cring (padic_int p)"
proof (rule cringI)
show "abelian_group (padic_int p)"
by (simp add: assms padic_is_abelian_group)
show "Group.comm_monoid (padic_int p)"
by (simp add: assms padic_is_comm_monoid)
show "⋀x y z.
x ∈ carrier (padic_int p) ⟹
y ∈ carrier (padic_int p) ⟹
z ∈ carrier (padic_int p) ⟹
(x ⊕⇘padic_int p⇙ y) ⊗⇘padic_int p⇙ z =
x ⊗⇘padic_int p⇙ z ⊕⇘padic_int p⇙ y ⊗⇘padic_int p⇙ z "
proof-
fix x y z
assume Ax: " x ∈ carrier (padic_int p)"
assume Ay: " y ∈ carrier (padic_int p)"
assume Az: " z ∈ carrier (padic_int p)"
show "(x ⊕⇘padic_int p⇙ y) ⊗⇘padic_int p⇙ z
= x ⊗⇘padic_int p⇙ z ⊕⇘padic_int p⇙ y ⊗⇘padic_int p⇙ z"
proof
fix n
have Ex: " (x n) ∈ carrier (residue_ring (p^n))"
using Ax padic_set_def padic_int_simps by auto
have Ey: " (y n) ∈ carrier (residue_ring (p^n))"
using Ay padic_set_def padic_int_simps by auto
have Ez: " (z n) ∈ carrier (residue_ring (p^n))"
using Az padic_set_def padic_int_simps by auto
show "( (x ⊕⇘padic_int p⇙ y) ⊗⇘padic_int p⇙ z) n
= (x ⊗⇘padic_int p⇙ z ⊕⇘padic_int p⇙ y ⊗⇘padic_int p⇙ z) n "
proof(cases "n=0")
case True
then show ?thesis
by (metis Ax Ay Az assms padic_add_closed padic_int_simps(4) padic_int_simps(5) padic_mult_in_padic_set padic_set_zero_res)
next
case False
then have "residues (p^n)"
by (simp add: assms residues_n)
then show ?thesis
using Ex Ey Ez cring.cring_simprules(13) padic_add_res padic_int_simps
padic_mult_res residues.cring by fastforce
qed
qed
qed
qed
text‹The $p$-adic ring has no nontrivial zero divisors. Note that this argument is short because we have proved that the valuation is multiplicative on nonzero elements, which is where the primality assumption is used.›
lemma padic_no_zero_divisors:
assumes "prime p"
assumes "a ∈ carrier (padic_int p)"
assumes "b ∈carrier (padic_int p)"
assumes "a ≠𝟬⇘padic_int p⇙ "
assumes "b ≠𝟬⇘padic_int p⇙ "
shows "a ⊗⇘padic_int p⇙ b ≠ 𝟬⇘padic_int p⇙ "
proof
assume C: "a ⊗⇘padic_int p⇙ b = 𝟬⇘padic_int p⇙"
show False
proof-
have 0: "a = 𝟬⇘padic_int p⇙ ∨ b = 𝟬⇘padic_int p⇙"
proof(cases "a = 𝟬⇘padic_int p⇙")
case True
then show ?thesis by auto
next
case False
have "¬ b ≠𝟬⇘padic_int p⇙"
proof
assume "b ≠ 𝟬⇘padic_int p⇙"
have "padic_val p (a ⊗⇘padic_int p⇙ b) = (padic_val p a) + (padic_val p b)"
using False assms(1) assms(2) assms(3) assms(5) val_prod padic_int_simps by auto
then have "padic_val p (a ⊗⇘padic_int p⇙ b) ≠ -1"
using False ‹b ≠ 𝟬⇘padic_int p⇙› padic_val_def padic_int_simps by auto
then show False
using C padic_val_def padic_int_simps by auto
qed
then show ?thesis
by blast
qed
show ?thesis
using "0" assms(4) assms(5) by blast
qed
qed
lemma padic_int_is_domain:
assumes "prime p"
shows "domain (padic_int p)"
proof(rule domainI)
show "cring (padic_int p)"
using padic_int_is_cring assms(1) by auto
show "𝟭⇘padic_int p⇙ ≠ 𝟬⇘padic_int p⇙"
proof
assume "𝟭⇘padic_int p⇙ = 𝟬⇘padic_int p⇙ "
then have "(𝟭⇘padic_int p⇙) 1 = 𝟬⇘padic_int p⇙ 1" by auto
then show False
using padic_int_simps(1,2)
unfolding padic_one_def padic_zero_def by auto
qed
show "⋀a b. a ⊗⇘padic_int p⇙ b = 𝟬⇘padic_int p⇙ ⟹
a ∈ carrier (padic_int p) ⟹
b ∈ carrier (padic_int p) ⟹
a = 𝟬⇘padic_int p⇙ ∨ b = 𝟬⇘padic_int p⇙"
using assms padic_no_zero_divisors
by (meson prime_nat_int_transfer)
qed
section‹The Ultrametric Inequality:›
lemma padic_val_ultrametric:
assumes "prime p"
assumes "a ∈ carrier (padic_int p) "
assumes "b ∈ carrier (padic_int p) "
assumes "a ≠ 𝟬⇘(padic_int p)⇙"
assumes "b ≠ 𝟬⇘(padic_int p)⇙"
assumes "a ⊕⇘(padic_int p)⇙ b ≠ 𝟬⇘(padic_int p)⇙"
shows "padic_val p (a ⊕⇘(padic_int p)⇙ b) ≥ min (padic_val p a) (padic_val p b)"
proof-
let ?va = " nat (padic_val p a)"
let ?vb = "nat (padic_val p b)"
let ?vab = "nat (padic_val p (a ⊕⇘(padic_int p)⇙ b))"
have P:" ¬ ?vab < min ?va ?vb"
proof
assume P0: "?vab < min ?va ?vb"
then have "Suc ?vab ≤ min ?va ?vb"
using Suc_leI by blast
have "(a ⊕⇘(padic_int p)⇙ b) ∈ carrier (padic_int p) "
using assms(1) assms(2) assms(3) padic_add_closed by simp
then have C: "(a ⊕⇘(padic_int p)⇙ b) (?vab + 1) ≠ 𝟬⇘residue_ring (p^(?vab + 1))⇙"
using val_of_nonzero(1) assms(6)
by (simp add: padic_int_def val_of_nonzero(1) assms(1))
have S: "(a ⊕⇘(padic_int p)⇙ b) (?vab + 1) = (a (?vab + 1)) ⊕⇘residue_ring (p^((?vab + 1)))⇙ (b ((?vab + 1)))"
by (simp add: padic_int_def padic_add_def)
have "int (?vab + 1) ≤ padic_val p a"
using P0 using Suc_le_eq by auto
then have A: "(a (?vab + 1)) = 𝟬⇘residue_ring (p^((?vab + 1)))⇙ "
using assms(1) assms(2) zero_below_val padic_int_simps residue_ring_def
by auto
have "int (?vab + 1) ≤ padic_val p b"
using P0 using Suc_le_eq by auto
then have B: "(b (?vab + 1)) = 𝟬⇘residue_ring (p^((?vab + 1)))⇙ "
using assms(1) assms(3) zero_below_val
by (metis A ‹int (nat (padic_val p (a ⊕⇘padic_int p⇙ b)) + 1) ≤ padic_val p a›
assms(2) padic_int_simps(3,5))
have "p^(?vab + 1) > 1"
using assms(1) by (metis add.commute plus_1_eq_Suc power_gt1 prime_gt_1_int)
then have "residues (p^(?vab + 1))"
using less_imp_of_nat_less residues.intro by fastforce
then have "(a ⊕⇘(padic_int p)⇙ b) (?vab + 1) = 𝟬⇘residue_ring (p^((?vab + 1)))⇙ "
using A B by (metis (no_types, lifting) S cring.cring_simprules(2)
cring.cring_simprules(8) residues.cring)
then show False using C by auto
qed
have A0: "(padic_val p a) ≥ 0"
using assms(4) padic_val_def by(auto simp: padic_int_def)
have A1: "(padic_val p b) ≥ 0"
using assms(5) padic_val_def by(auto simp: padic_int_def)
have A2: "padic_val p (a ⊕⇘(padic_int p)⇙ b) ≥ 0"
using assms(6) padic_val_def by(auto simp: padic_int_def)
show ?thesis using P A0 A1 A2
by linarith
qed
lemma padic_a_inv:
assumes "prime p"
assumes "a ∈ carrier (padic_int p)"
shows "⊖⇘padic_int p⇙ a = (λ n. ⊖⇘residue_ring (p^n)⇙ (a n))"
proof
fix n
show "(⊖⇘padic_int p⇙ a) n = ⊖⇘residue_ring (p^n)⇙ a n"
proof(cases "n=0")
case True
then show ?thesis
by (metis (no_types, lifting) abelian_group.a_inv_closed assms(1) assms(2) padic_int_simps(5)
padic_is_abelian_group padic_set_zero_res power_0 residue_1_prop residue_ring_def ring.simps(1))
next
case False
then have R: "residues (p^n)"
by (simp add: assms(1) residues_n)
have "(⊖⇘padic_int p⇙ a) ⊕⇘padic_int p⇙ a = 𝟬⇘padic_int p⇙"
by (simp add: abelian_group.l_neg assms(1) assms(2) padic_is_abelian_group)
then have P: "(⊖⇘padic_int p⇙ a) n ⊕⇘residue_ring (p^n)⇙ a n = 0"
by (metis padic_add_res padic_int_simps(2) padic_int_simps(3) padic_zero_def)
have Q: "(a n) ∈ carrier (residue_ring (p^n))"
using assms(2) padic_set_res_closed by(auto simp: padic_int_def)
show ?thesis using R Q residues.cring
by (metis P abelian_group.a_inv_closed abelian_group.minus_equality assms(1) assms(2)
padic_int_simps(5) padic_is_abelian_group padic_set_res_closed residues.abelian_group
residues.res_zero_eq)
qed
qed
lemma padic_val_a_inv:
assumes "prime p"
assumes "a ∈ carrier (padic_int p)"
shows "padic_val p a = padic_val p (⊖⇘padic_int p⇙ a)"
proof(cases "a = 𝟬⇘padic_int p⇙")
case True
then show ?thesis
by (metis abelian_group.a_inv_closed abelian_group.r_neg abelian_groupE(5) assms(1) assms(2) padic_is_abelian_group)
next
case False
have 0: "⋀ n. (a n) = 𝟬⇘residue_ring (p^n)⇙ ⟹ (⊖⇘padic_int p⇙ a) n = 𝟬⇘residue_ring (p^n)⇙"
using padic_a_inv
by (metis (no_types, lifting) assms(1) assms(2) cring.cring_simprules(22) power_0 residue_1_prop residues.cring residues_n)
have 1: "⋀ n. (a n) ≠ 𝟬⇘residue_ring (p^n)⇙ ⟹ (⊖⇘padic_int p⇙ a) n ≠ 𝟬⇘residue_ring (p^n)⇙"
using padic_a_inv
by (metis (no_types, lifting) abelian_group.a_inv_closed abelian_group.minus_minus assms(1)
assms(2) cring.cring_simprules(22) padic_int_simps(5) padic_is_abelian_group padic_set_zero_res
residues.cring residues_n)
have A:"padic_val p (⊖⇘padic_int p⇙ a) ≥ (padic_val p a)"
proof-
have "¬ padic_val p (⊖⇘padic_int p⇙ a) < (padic_val p a)"
proof
assume "padic_val p (⊖⇘padic_int p⇙ a) < padic_val p a"
let ?n = "padic_val p (⊖⇘padic_int p⇙ a)"
let ?m = " padic_val p a"
have "(⊖⇘padic_int p⇙ a) ≠ (padic_zero p)"
by (metis False abelian_group.l_neg assms(1) assms(2) padic_add_zero padic_int_simps(2) padic_is_abelian_group)
then have P0: "?n ≥0"
by (simp add: padic_val_def)
have P1: "?m ≥0" using False
using ‹0 ≤ padic_val p (⊖⇘padic_int p⇙ a)›
‹padic_val p (⊖⇘padic_int p⇙ a) < padic_val p a› by linarith
have "(Suc (nat ?n)) < Suc (nat (padic_val p a))"
using P0 P1 ‹padic_val p (⊖⇘padic_int p⇙ a) < padic_val p a› by linarith
then have "int (Suc (nat ?n)) ≤ (padic_val p a)"
using of_nat_less_iff by linarith
then have "a (Suc (nat ?n)) = 𝟬⇘residue_ring (p ^ ((Suc (nat ?n))))⇙"
using assms(1) assms(2) zero_below_val residue_ring_def by(auto simp: padic_int_def)
then have "(⊖⇘padic_int p⇙ a) (Suc (nat ?n)) = 𝟬⇘residue_ring (p ^ ((Suc (nat ?n))))⇙"
using 0 by simp
then show False using below_val_zero assms
by (metis Suc_eq_plus1 ‹⊖⇘padic_int p⇙ a ≠ padic_zero p› abelian_group.a_inv_closed
padic_int_simps(5) padic_is_abelian_group val_of_nonzero(1))
qed
then show ?thesis
by linarith
qed
have B: "padic_val p (⊖⇘padic_int p⇙ a) ≤ (padic_val p a)"
proof-
let ?n = "nat (padic_val p a)"
have "a (Suc ?n) ≠ 𝟬⇘residue_ring (p^(Suc ?n))⇙ "
using False assms(2) val_of_nonzero(1)
by (metis padic_int_simps(2,5) Suc_eq_plus1 assms(1))
then have "(⊖⇘padic_int p⇙ a) (Suc ?n) ≠ 𝟬⇘residue_ring (p^(Suc ?n))⇙ "
using 1 by blast
then have "padic_val p (⊖⇘padic_int p⇙ a) ≤ int ?n" using assms(1) assms(2) below_val_zero
by (metis padic_int_simps(5) abelian_group.a_inv_closed padic_is_abelian_group)
then show ?thesis
using False padic_val_def padic_int_simps by auto
qed
then show ?thesis using A B by auto
qed
end
Theory Padic_Integers
theory Padic_Integers
imports Padic_Construction
Extended_Int
Supplementary_Ring_Facts
"HOL-Algebra.Subrings"
"HOL-Number_Theory.Residues"
"HOL-Algebra.Multiplicative_Group"
begin
text‹
In what follows we establish a locale for reasoning about the ring of $p$-adic integers for a
fixed prime $p$. We will elaborate on the basic metric properties of $\mathbb{Z}_p$ and construct
the angular component maps to the residue rings.
›
section‹A Locale for $p$-adic Integer Rings›
locale padic_integers =
fixes Zp:: "_ ring" (structure)
fixes p
defines "Zp ≡ padic_int p"
assumes prime: "prime p"
sublocale padic_integers < UPZ?: UP Zp "UP Zp"
by simp
sublocale padic_integers < Zp?:UP_cring Zp "UP Zp"
unfolding UP_cring_def
by(auto simp add: Zp_def padic_int_is_cring prime)
sublocale padic_integers < Zp?:ring Zp
using Zp_def cring.axioms(1) padic_int_is_cring prime
by blast
sublocale padic_integers < Zp?:cring Zp
by (simp add: Zp_def padic_int_is_cring prime)
sublocale padic_integers < Zp?:domain Zp
by (simp add: Zp_def padic_int_is_domain padic_integers.prime padic_integers_axioms)
context padic_integers
begin
lemma Zp_defs:
"𝟭 = padic_one p"
"𝟬 = padic_zero p"
"carrier Zp = padic_set p"
"(⊗) = padic_mult p"
"(⊕) = padic_add p"
unfolding Zp_def using padic_int_simps by auto
end
section ‹Residue Rings›
lemma(in field) field_inv:
assumes "a ∈ carrier R"
assumes "a ≠𝟬"
shows "inv⇘R⇙ a ⊗ a = 𝟭"
"a ⊗ inv⇘R⇙ a = 𝟭"
"inv ⇘R⇙ a ∈ carrier R"
proof-
have "a ∈ Units R"
using assms by (simp add: local.field_Units)
then show "inv⇘R⇙ a ⊗ a = 𝟭"
by simp
show "a ⊗ inv a = 𝟭"
using ‹a ∈ Units R› by auto
show "inv ⇘R⇙ a ∈ carrier R"
by (simp add: ‹a ∈ Units R›)
qed
text‹$p_residue$ defines the standard projection maps between residue rings:›
definition(in padic_integers) p_residue:: "nat ⇒ int ⇒ _" where
"p_residue m n ≡ residue (p^m) n"
lemma(in padic_integers) p_residue_alt_def:
"p_residue m n = n mod (p^m)"
using residue_def
by (simp add: p_residue_def)
lemma(in padic_integers) p_residue_range:
"p_residue m n ∈ {0..<p^m}"
using p_residue_def int_ops(6) prime prime_gt_0_nat
by (metis Euclidean_Division.pos_mod_bound Euclidean_Division.pos_mod_sign atLeastLessThan_iff p_residue_alt_def prime_gt_0_int zero_less_power)
lemma(in padic_integers) p_residue_mod:
assumes "m > k"
shows "p_residue k (p_residue m n) = p_residue k n"
using assms
unfolding p_residue_def residue_def
by (simp add: le_imp_power_dvd mod_mod_cancel)
text‹Compatibility of p\_residue with elements of $\mathbb{Z}_p$:›
lemma(in padic_integers) p_residue_padic_int:
assumes "x ∈ carrier Zp"
assumes "m ≥ k"
shows "p_residue k (x m) = x k"
using Zp_def assms(1) assms(2) padic_set_res_coherent prime
by (simp add: p_residue_def padic_int_simps(5))
text‹Definition of residue rings:›
abbreviation(in padic_integers) (input) Zp_res_ring:: "nat ⇒ _ ring" where
"(Zp_res_ring n) ≡ residue_ring (p^n)"
lemma (in padic_integers) p_res_ring_zero:
"𝟬⇘Zp_res_ring k⇙ = 0"
by (simp add: residue_ring_def)
lemma (in padic_integers) p_res_ring_one:
assumes "k > 0"
shows "𝟭⇘Zp_res_ring k⇙ = 1"
using assms
by (simp add: residue_ring_def)
lemma (in padic_integers) p_res_ring_car:
"carrier (Zp_res_ring k) = {0..<p^k}"
using residue_ring_def[of "p^k"]
by auto
lemma(in padic_integers) p_residue_range':
"p_residue m n ∈ carrier (Zp_res_ring m)"
using p_residue_range residue_ring_def prime prime_gt_0_nat p_residue_def
by fastforce
text‹First residue ring is a field:›
lemma(in padic_integers) p_res_ring_1_field:
"field (Zp_res_ring 1)"
by (metis int_nat_eq power_one_right prime prime_ge_0_int prime_nat_int_transfer residues_prime.intro residues_prime.is_field)
text‹$0^{th}$ residue ring is the zero ring:›
lemma(in padic_integers) p_res_ring_0:
"carrier (Zp_res_ring 0) = {0}"
by (simp add: residue_ring_def)
lemma(in padic_integers) p_res_ring_0':
assumes "x ∈ carrier (Zp_res_ring 0)"
shows "x = 0"
using p_res_ring_0 assms by blast
text‹If $m>0$ then $Zp\_res\_ring m$ is an instance of the residues locale:›
lemma(in padic_integers) p_residues:
assumes "m >0"
shows "residues (p^m)"
proof-
have "p^m > 1"
using assms
by (simp add: prime prime_gt_1_int)
then show "residues (p^m)"
using less_imp_of_nat_less residues.intro by fastforce
qed
text‹If $m>0$ then $Zp\_res\_ring m$ is a commutative ring:›
lemma(in padic_integers) R_cring:
assumes "m >0"
shows "cring (Zp_res_ring m)"
using p_residues assms residues.cring by auto
lemma(in padic_integers) R_comm_monoid:
assumes "m >0"
shows "comm_monoid (Zp_res_ring m)"
by (simp add: assms p_residues residues.comm_monoid)
lemma(in padic_integers) zero_rep:
"𝟬 = (λm. (p_residue m 0))"
unfolding p_residue_def
using Zp_defs(2) padic_zero_simp(1) residue_def residue_ring_def by auto
text‹The operations on residue rings are just the standard operations on the integers $\mod p^n$. This means that the basic closure properties and algebraic properties of operations on these rings hold for all integers, not just elements of the ring carrier:›
lemma(in padic_integers) residue_add:
shows "(x ⊕⇘Zp_res_ring k⇙ y) = (x + y) mod p^k"
unfolding residue_ring_def
by simp
lemma(in padic_integers) residue_add_closed:
shows "(x ⊕⇘Zp_res_ring k⇙ y) ∈ carrier (Zp_res_ring k)"
using p_residue_def p_residue_range residue_def residue_ring_def by auto
lemma(in padic_integers) residue_add_closed':
shows "(x ⊕⇘Zp_res_ring k⇙ y) ∈ {0..<p^k}"
using residue_add_closed residue_ring_def by auto
lemma(in padic_integers) residue_mult:
shows "(x ⊗⇘Zp_res_ring k⇙ y) = (x * y) mod p^k"
unfolding residue_ring_def
by simp
lemma(in padic_integers) residue_mult_closed:
shows "(x ⊗⇘Zp_res_ring k⇙ y) ∈ carrier (Zp_res_ring k)"
using p_residue_def p_residue_range residue_def residue_ring_def by auto
lemma(in padic_integers) residue_mult_closed':
shows "(x ⊗⇘Zp_res_ring k⇙ y) ∈ {0..<p^k}"
using residue_mult_closed residue_ring_def by auto
lemma(in padic_integers) residue_add_assoc:
shows "(x ⊕⇘Zp_res_ring k⇙ y) ⊕⇘Zp_res_ring k⇙ z = x ⊕⇘Zp_res_ring k⇙ (y ⊕⇘Zp_res_ring k⇙ z)"
using residue_add
by (simp add: add.commute add.left_commute mod_add_right_eq)
lemma(in padic_integers) residue_mult_comm:
shows "x ⊗⇘Zp_res_ring k⇙ y = y ⊗⇘Zp_res_ring k⇙ x"
using residue_mult
by (simp add: mult.commute)
lemma(in padic_integers) residue_mult_assoc:
shows "(x ⊗⇘Zp_res_ring k⇙ y) ⊗⇘Zp_res_ring k⇙ z = x ⊗⇘Zp_res_ring k⇙ (y ⊗⇘Zp_res_ring k⇙ z)"
using residue_mult
by (simp add: mod_mult_left_eq mod_mult_right_eq mult.assoc)
lemma(in padic_integers) residue_add_comm:
shows "x ⊕⇘Zp_res_ring k⇙ y = y ⊕⇘Zp_res_ring k⇙ x"
using residue_add
by presburger
lemma(in padic_integers) residue_minus_car:
assumes "y ∈ carrier (Zp_res_ring k)"
shows "(x ⊖⇘Zp_res_ring k⇙ y) = (x - y) mod p^k"
proof(cases "k = 0")
case True
then show ?thesis
using residue_ring_def a_minus_def
by(simp add: a_minus_def residue_ring_def)
next
case False
have "(x ⊖⇘Zp_res_ring k⇙ y) ⊕⇘Zp_res_ring k⇙ y = x ⊕⇘Zp_res_ring k⇙ (⊖⇘Zp_res_ring k⇙ y ⊕⇘Zp_res_ring k⇙ y)"
by (simp add: a_minus_def residue_add_assoc)
then have 0: "(x ⊖⇘Zp_res_ring k⇙ y) ⊕⇘Zp_res_ring k⇙ y = x mod p^k"
using assms False
by (smt cring.cring_simprules(9) prime residue_add residues.cring residues.res_zero_eq residues_n)
have 1: "x mod p ^ k = ((x - y) mod p ^ k + y) mod p ^ k"
proof -
have f1: "x - y = x + - 1 * y"
by auto
have "y + (x + - 1 * y) = x"
by simp
then show ?thesis
using f1 by presburger
qed
have "(x ⊖⇘Zp_res_ring k⇙ y) ⊕⇘Zp_res_ring k⇙ y = (x - y) mod p^k ⊕⇘Zp_res_ring k⇙ y"
using residue_add[of k "(x - y) mod p^k" y] 0 1
by linarith
then show ?thesis using assms residue_add_closed
by (metis False a_minus_def cring.cring_simprules(10) cring.cring_simprules(19)
prime residues.cring residues.mod_in_carrier residues_n)
qed
lemma(in padic_integers) residue_a_inv:
shows "⊖⇘Zp_res_ring k⇙ y = ⊖⇘Zp_res_ring k⇙ (y mod p^k)"
proof-
have "y ⊕⇘Zp_res_ring k⇙ (⊖⇘Zp_res_ring k⇙ (y mod p^k)) = (y mod p^k) ⊕⇘Zp_res_ring k⇙ (⊖⇘Zp_res_ring k⇙ (y mod p^k)) "
using residue_minus_car[of "⊖⇘Zp_res_ring k⇙ (y mod p^k)" k y] residue_add
by (simp add: mod_add_left_eq)
then have 0: "y ⊕⇘Zp_res_ring k⇙ (⊖⇘Zp_res_ring k⇙ (y mod p^k)) = 𝟬⇘Zp_res_ring k⇙"
by (metis cring.cring_simprules(17) p_res_ring_zero padic_integers.p_res_ring_0'
padic_integers_axioms prime residue_add_closed residues.cring residues.mod_in_carrier residues_n)
have 1: "(⊖⇘Zp_res_ring k⇙ (y mod p^k)) ⊕⇘Zp_res_ring k⇙ y = 𝟬⇘Zp_res_ring k⇙"
using residue_add_comm 0 by auto
have 2: "⋀x. x ∈ carrier (Zp_res_ring k) ∧ x ⊕⇘Zp_res_ring k⇙ y = 𝟬⇘Zp_res_ring k⇙ ∧ y ⊕⇘Zp_res_ring k⇙ x = 𝟬⇘Zp_res_ring k⇙ ⟹ x = ⊖⇘Zp_res_ring k⇙ (y mod p^k)"
using 0 1
by (metis cring.cring_simprules(3) cring.cring_simprules(8) mod_by_1 padic_integers.p_res_ring_0'
padic_integers.p_res_ring_zero padic_integers_axioms power_0 prime residue_1_prop
residue_add_assoc residues.cring residues.mod_in_carrier residues_n)
have 3: "carrier (add_monoid (residue_ring (p ^ k))) = carrier (Zp_res_ring k)"
by simp
have 4: "(⊗⇘add_monoid (residue_ring (p ^ k))⇙) = (⊕⇘Zp_res_ring k⇙)"
by simp
have 5: "⋀x. x ∈ carrier (add_monoid (residue_ring (p ^ k))) ∧
x ⊗⇘add_monoid (residue_ring (p ^ k))⇙ y = 𝟭⇘add_monoid (residue_ring (p ^ k))⇙ ∧
y ⊗⇘add_monoid (residue_ring (p ^ k))⇙ x = 𝟭⇘add_monoid (residue_ring (p ^ k))⇙
⟹ x = ⊖⇘Zp_res_ring k⇙ (y mod p^k)"
using 0 1 2 3 4
by simp
show ?thesis
unfolding a_inv_def m_inv_def
apply(rule the_equality)
using 1 2 3 4 5 unfolding a_inv_def m_inv_def
apply (metis (no_types, lifting) "0" "1" cring.cring_simprules(3) mod_by_1
monoid.select_convs(2) padic_integers.p_res_ring_zero padic_integers_axioms power_0 prime
residue_1_prop residue_add_closed residues.cring residues.mod_in_carrier residues_n)
using 1 2 3 4 5 unfolding a_inv_def m_inv_def
by blast
qed
lemma(in padic_integers) residue_a_inv_closed:
"⊖⇘Zp_res_ring k⇙ y ∈ carrier (Zp_res_ring k)"
apply(cases "k = 0")
apply (metis add.comm_neutral add.commute
atLeastLessThanPlusOne_atLeastAtMost_int
insert_iff mod_by_1 p_res_ring_car p_res_ring_zero padic_integers.p_res_ring_0
padic_integers_axioms power_0 residue_1_prop residue_a_inv)
by (simp add: prime residues.mod_in_carrier residues.res_neg_eq residues_n)
lemma(in padic_integers) residue_minus:
"(x ⊖⇘Zp_res_ring k⇙ y) = (x - y) mod p^k"
using residue_minus_car[of "y mod p^k" k x] residue_a_inv[of k y] unfolding a_minus_def
by (metis a_minus_def mod_diff_right_eq p_residue_alt_def p_residue_range')
lemma(in padic_integers) residue_minus_closed:
"(x ⊖⇘Zp_res_ring k⇙ y) ∈ carrier (Zp_res_ring k)"
by (simp add: a_minus_def residue_add_closed)
lemma (in padic_integers) residue_plus_zero_r:
"0 ⊕⇘Zp_res_ring k⇙ y = y mod p^k"
by (simp add: residue_add)
lemma (in padic_integers) residue_plus_zero_l:
"y ⊕⇘Zp_res_ring k⇙ 0 = y mod p^k"
by (simp add: residue_add)
lemma (in padic_integers) residue_times_zero_r:
"0 ⊗⇘Zp_res_ring k⇙ y = 0"
by (simp add: residue_mult)
lemma (in padic_integers) residue_times_zero_l:
"y ⊗⇘Zp_res_ring k⇙ 0 = 0"
by (simp add: residue_mult)
lemma (in padic_integers) residue_times_one_r:
"1 ⊗⇘Zp_res_ring k⇙ y = y mod p^k"
by (simp add: residue_mult)
lemma (in padic_integers) residue_times_one_l:
"y ⊗⇘Zp_res_ring k⇙ 1 = y mod p^k"
by (simp add: residue_mult_comm residue_times_one_r)
text‹Similarly to the previous lemmas, many identities about taking residues of $p$-adic integers hold even for elements which lie outside the carrier of $\mathbb{Z}_p$:›
lemma (in padic_integers) residue_of_sum:
"(a ⊕ b) k = (a k) ⊕⇘Zp_res_ring k⇙ (b k)"
using Zp_def residue_ring_def[of "p^k"] Zp_defs(5) padic_add_res
by auto
lemma (in padic_integers) residue_of_sum':
"(a ⊕ b) k = ((a k) + (b k)) mod p^k"
using residue_add residue_of_sum by auto
lemma (in padic_integers) residue_closed[simp]:
assumes "b ∈ carrier Zp"
shows "b k ∈ carrier (Zp_res_ring k)"
using Zp_def assms padic_integers.Zp_defs(3) padic_integers_axioms padic_set_res_closed
by auto
lemma (in padic_integers) residue_of_diff:
assumes "b ∈ carrier Zp"
shows "(a ⊖ b) k = (a k) ⊖⇘Zp_res_ring k⇙ (b k)"
unfolding a_minus_def
using Zp_def add.inv_closed assms(1) padic_a_inv prime residue_of_sum by auto
lemma (in padic_integers) residue_of_prod:
"(a ⊗ b) k = (a k) ⊗ ⇘Zp_res_ring k⇙ (b k)"
by (simp add: Zp_defs(4) padic_mult_def)
lemma (in padic_integers) residue_of_prod':
"(a ⊗ b) k = ((a k) * (b k)) mod (p^k)"
by (simp add: residue_mult residue_of_prod)
lemma (in padic_integers) residue_of_one:
assumes "k > 0"
shows "𝟭 k = 𝟭⇘Zp_res_ring k⇙"
"𝟭 k = 1"
apply (simp add: Zp_defs(1) assms padic_one_simp(1))
by (simp add: Zp_def assms padic_int_simps(1) padic_one_simp(1) residue_ring_def)
lemma (in padic_integers) residue_of_zero:
shows "𝟬 k = 𝟬⇘Zp_res_ring k⇙"
"𝟬 k = 0"
apply (simp add: Zp_defs(2) padic_zero_simp(1))
by (simp add: p_residue_alt_def zero_rep)
lemma(in padic_integers) Zp_residue_mult_zero:
assumes "a k = 0"
shows "(a ⊗ b) k = 0" "(b ⊗ a) k = 0"
using assms residue_of_prod'
by auto
lemma(in padic_integers) Zp_residue_add_zero:
assumes "b ∈ carrier Zp"
assumes "(a:: padic_int) k = 0"
shows "(a ⊕ b) k = b k" "(b ⊕ a) k = b k"
apply (metis Zp_def assms(1) assms(2) cring.cring_simprules(8) mod_by_1 padic_int_is_cring power.simps(1)
prime residue_add_closed residue_of_sum residue_of_sum' residues.cring residues.res_zero_eq residues_n)
by (metis Zp_def assms(1) assms(2) cring.cring_simprules(16) mod_by_1 padic_int_is_cring
power.simps(1) prime residue_add_closed residue_of_sum residue_of_sum' residues.cring
residues.res_zero_eq residues_n)
text‹P-adic addition and multiplication are globally additive and associative:›
lemma padic_add_assoc0:
assumes "prime p"
shows "padic_add p (padic_add p x y) z = padic_add p x (padic_add p y z)"
using assms unfolding padic_add_def
by (simp add: padic_integers.residue_add_assoc padic_integers_def)
lemma(in padic_integers) add_assoc:
"a ⊕ b ⊕ c = a ⊕ (b ⊕ c)"
using padic_add_assoc0[of p a b c] prime Zp_defs by auto
lemma padic_add_comm0:
assumes "prime p"
shows "(padic_add p x y)= (padic_add p y x)"
using assms unfolding padic_add_def
using padic_integers.residue_add_comm[of p]
by (simp add: padic_integers_def)
lemma(in padic_integers) add_comm:
"a ⊕ b = b ⊕ a"
using padic_add_comm0[of p a b] prime Zp_defs by auto
lemma padic_mult_assoc0:
assumes "prime p"
shows "padic_mult p (padic_mult p x y) z = padic_mult p x (padic_mult p y z)"
using assms unfolding padic_mult_def
by (simp add: padic_integers.residue_mult_assoc padic_integers_def)
lemma(in padic_integers) mult_assoc:
"a ⊗ b ⊗ c = a ⊗ (b ⊗ c)"
using padic_mult_assoc0[of p a b c] prime Zp_defs by auto
lemma padic_mult_comm0:
assumes "prime p"
shows "(padic_mult p x y)= (padic_mult p y x)"
using assms unfolding padic_mult_def
using padic_integers.residue_mult_comm[of p]
by (simp add: padic_integers_def)
lemma(in padic_integers) mult_comm:
"a ⊗ b = b ⊗ a"
using padic_mult_comm0[of p a b] prime Zp_defs by auto
lemma(in padic_integers) mult_zero_l:
"a ⊗ 𝟬 = 𝟬"
proof fix x show "(a ⊗ 𝟬) x = 𝟬 x"
using Zp_residue_mult_zero[of 𝟬 x a]
by (simp add: residue_of_zero(2))
qed
lemma(in padic_integers) mult_zero_r:
"𝟬 ⊗ a = 𝟬"
using mult_zero_l mult_comm by auto
lemma (in padic_integers) p_residue_ring_car_memI:
assumes "(m::int) ≥0"
assumes "m < p^k"
shows "m ∈ carrier (Zp_res_ring k)"
using residue_ring_def[of "p^k"] assms(1) assms(2)
by auto
lemma (in padic_integers) p_residue_ring_car_memE:
assumes "m ∈ carrier (Zp_res_ring k)"
shows "m < p^k" "m ≥ 0"
using assms residue_ring_def by auto
lemma (in padic_integers) residues_closed:
assumes "a ∈ carrier Zp"
shows "a k ∈ carrier (Zp_res_ring k)"
using Zp_def assms padic_integers.Zp_defs(3) padic_integers_axioms padic_set_res_closed by blast
lemma (in padic_integers) mod_in_carrier:
"a mod (p^n) ∈ carrier (Zp_res_ring n)"
using p_residue_alt_def p_residue_range' by auto
lemma (in padic_integers) Zp_residue_a_inv:
assumes "a ∈ carrier Zp"
shows "(⊖ a) k = ⊖⇘Zp_res_ring k⇙ (a k)"
"(⊖ a) k = (- (a k)) mod (p^k)"
using Zp_def assms padic_a_inv prime apply auto[1]
using residue_a_inv
by (metis Zp_def assms mod_by_1 p_res_ring_zero padic_a_inv padic_integers.prime
padic_integers_axioms power_0 residue_1_prop residues.res_neg_eq residues_n)
lemma (in padic_integers) residue_of_diff':
assumes "b ∈ carrier Zp"
shows "(a ⊖ b) k = ((a k) - (b k)) mod (p^k)"
by (simp add: assms residue_minus_car residue_of_diff residues_closed)
lemma (in padic_integers) residue_UnitsI:
assumes "n ≥ 1"
assumes "(k::int) > 0"
assumes "k < p^n"
assumes "coprime k p"
shows "k ∈ Units (Zp_res_ring n)"
using residues.res_units_eq assms
by (metis (mono_tags, lifting) coprime_power_right_iff mem_Collect_eq not_one_le_zero prime residues_n)
lemma (in padic_integers) residue_UnitsE:
assumes "n ≥ 1"
assumes "k ∈ Units (Zp_res_ring n)"
shows "coprime k p"
using residues.res_units_eq assms
by (simp add: p_residues)
lemma(in padic_integers) residue_units_nilpotent:
assumes "m > 0"
assumes "k = card (Units (Zp_res_ring m))"
assumes "x ∈ (Units (Zp_res_ring m))"
shows "x[^]⇘Zp_res_ring m⇙ k = 1"
proof-
have 0: "group (units_of (Zp_res_ring m))"
using assms(1) cring_def monoid.units_group padic_integers.R_cring
padic_integers_axioms ring_def
by blast
have 1: "finite (Units (Zp_res_ring m))"
using p_residues assms(1) residues.finite_Units
by auto
have 2: "x[^]⇘units_of (Zp_res_ring m)⇙ (order (units_of (Zp_res_ring m))) = 𝟭⇘units_of (Zp_res_ring m)⇙"
by (metis "0" assms(3) group.pow_order_eq_1 units_of_carrier)
then show ?thesis
by (metis "1" assms(1) assms(2) assms(3) cring.units_power_order_eq_one
padic_integers.R_cring padic_integers.p_residues padic_integers_axioms residues.res_one_eq)
qed
lemma (in padic_integers) residue_1_unit:
assumes "m > 0"
shows "1 ∈ Units (Zp_res_ring m)"
"𝟭⇘Zp_res_ring m⇙ ∈ Units (Zp_res_ring m)"
proof-
have 0: "group (units_of (Zp_res_ring m))"
using assms(1) cring_def monoid.units_group padic_integers.R_cring
padic_integers_axioms ring_def
by blast
have 1: "1 = 𝟭⇘units_of (Zp_res_ring m)⇙"
by (simp add: residue_ring_def units_of_def)
have "𝟭⇘units_of (Zp_res_ring m)⇙ ∈ carrier (units_of (Zp_res_ring m))"
using 0 Group.monoid.intro[of "units_of (Zp_res_ring m)"]
by (simp add: group.is_monoid)
then show "1 ∈ Units (Zp_res_ring m)"
using 1 by (simp add: units_of_carrier)
then show " 𝟭⇘Zp_res_ring m⇙ ∈ Units (Zp_res_ring m) "
by (simp add: "1" units_of_one)
qed
lemma (in padic_integers) zero_not_in_residue_units:
assumes "n ≥ 1"
shows "(0::int) ∉ Units (Zp_res_ring n)"
using assms p_residues residues.res_units_eq by auto
text‹Cardinality bounds on the units of residue rings:›
lemma (in padic_integers) residue_units_card_geq_2:
assumes "n ≥2"
shows "card (Units (Zp_res_ring n)) ≥ 2"
proof(cases "p = 2")
case True
then have "(3::int) ∈ Units (Zp_res_ring n)"
proof-
have "p ≥2"
by (simp add: True)
then have "p^n ≥ 2^n"
using assms
by (simp add: True)
then have "p^n ≥ 4"
using assms power_increasing[of 2 n 2]
by (simp add: True)
then have "(3::int) < p^n"
by linarith
then have 0: "(3::int) ∈ carrier (Zp_res_ring n)"
by (simp add: residue_ring_def)
have 1: "coprime 3 p"
by (simp add: True numeral_3_eq_3)
show ?thesis using residue_UnitsI[of n "3::int"]
using "1" ‹3 < p ^ n› assms by linarith
qed
then have 0: "{(1::int), 3} ⊆ Units (Zp_res_ring n)"
using assms padic_integers.residue_1_unit padic_integers_axioms by auto
have 1: "finite (Units (Zp_res_ring n))"
using assms padic_integers.p_residues padic_integers_axioms residues.finite_Units by auto
have 2: "{(1::int),3}⊆Units (Zp_res_ring n)"
using "0" by auto
have 3: "card {(1::int),3} = 2"
by simp
show ?thesis
using 2 1
by (metis "3" card_mono)
next
case False
have "1 ∈ Units (Zp_res_ring n)"
using assms padic_integers.residue_1_unit padic_integers_axioms by auto
have "2 ∈ Units (Zp_res_ring n)"
apply(rule residue_UnitsI)
using assms apply linarith
apply simp
proof-
show "2 < p^n"
proof-
have "p^n > p"
by (metis One_nat_def assms le_simps(3) numerals(2) power_one_right
power_strict_increasing_iff prime prime_gt_1_int)
then show ?thesis using False prime prime_gt_1_int[of p]
by auto
qed
show "coprime 2 p"
using False
by (metis of_nat_numeral prime prime_nat_int_transfer primes_coprime two_is_prime_nat)
qed
then have 0: "{(1::int), 2} ⊆ Units (Zp_res_ring n)"
using ‹1 ∈ Units (Zp_res_ring n)› by blast
have 1: "card {(1::int),2} = 2"
by simp
then show ?thesis
using residues.finite_Units 0
by (metis One_nat_def assms card_mono dual_order.trans
le_simps(3) one_le_numeral padic_integers.p_residues padic_integers_axioms)
qed
lemma (in padic_integers) residue_ring_card:
"finite (carrier (Zp_res_ring n)) ∧ card (carrier (Zp_res_ring n)) = nat (p^n)"
using p_res_ring_car[of n]
by simp
lemma(in comm_monoid) UnitsI:
assumes "a ∈ carrier G"
assumes "b ∈ carrier G"
assumes "a ⊗ b = 𝟭"
shows "a ∈ Units G" "b ∈ Units G"
unfolding Units_def using comm_monoid_axioms_def assms m_comm[of a b]
by auto
lemma(in comm_monoid) is_invI:
assumes "a ∈ carrier G"
assumes "b ∈ carrier G"
assumes "a ⊗ b = 𝟭"
shows "inv⇘G⇙ b = a" "inv⇘G⇙ a = b"
using assms inv_char m_comm
by auto
lemma (in padic_integers) residue_of_Units:
assumes "k > 0"
assumes "a ∈ Units Zp"
shows "a k ∈ Units (Zp_res_ring k)"
proof-
have 0: "a k ⊗⇘Zp_res_ring k⇙ (inv ⇘Zp⇙ a) k = 1"
by (metis R.Units_r_inv assms(1) assms(2) residue_of_one(2) residue_of_prod)
have 1: "a k ∈ carrier (Zp_res_ring k)"
by (simp add: R.Units_closed assms(2) residues_closed)
have 2: "(inv ⇘Zp⇙ a) k ∈ carrier (Zp_res_ring k)"
by (simp add: assms(2) residues_closed)
show ?thesis using 0 1 2 comm_monoid.UnitsI[of "Zp_res_ring k"]
using assms(1) p_residues residues.comm_monoid residues.res_one_eq
by presburger
qed
section‹$int$ and $nat$ inclusions in $\mathbb{Z}_p$.›
lemma(in ring) int_inc_zero:
"[(0::int)]⋅ 𝟭 = 𝟬"
by (simp add: add.int_pow_eq_id)
lemma(in ring) int_inc_zero':
assumes "x ∈ carrier R"
shows "[(0::int)] ⋅ x = 𝟬"
by (simp add: add.int_pow_eq_id assms)
lemma(in ring) nat_inc_zero:
"[(0::nat)]⋅ 𝟭 = 𝟬"
by auto
lemma(in ring) nat_mult_zero:
"[(0::nat)]⋅ x = 𝟬"
by simp
lemma(in ring) nat_inc_closed:
fixes n::nat
shows "[n] ⋅ 𝟭 ∈ carrier R"
by simp
lemma(in ring) nat_mult_closed:
fixes n::nat
assumes "x ∈ carrier R"
shows "[n] ⋅ x ∈ carrier R"
by (simp add: assms)
lemma(in ring) int_inc_closed:
fixes n::int
shows "[n] ⋅ 𝟭 ∈ carrier R"
by simp
lemma(in ring) int_mult_closed:
fixes n::int
assumes "x ∈ carrier R"
shows "[n] ⋅ x ∈ carrier R"
by (simp add: assms)
lemma(in ring) nat_inc_prod:
fixes n::nat
fixes m::nat
shows "[m]⋅([n] ⋅ 𝟭) = [(m*n)]⋅𝟭"
by (simp add: add.nat_pow_pow mult.commute)
lemma(in ring) nat_inc_prod':
fixes n::nat
fixes m::nat
shows "[(m*n)]⋅𝟭 = [m]⋅ 𝟭 ⊗ ([n] ⋅ 𝟭)"
by (simp add: add.nat_pow_pow add_pow_rdistr)
lemma(in padic_integers) Zp_nat_inc_zero:
shows "[(0::nat)] ⋅ x = 𝟬"
by simp
lemma(in padic_integers) Zp_int_inc_zero':
shows "[(0::int)] ⋅ x = 𝟬"
using Zp_nat_inc_zero[of x]
unfolding add_pow_def int_pow_def by auto
lemma(in padic_integers) Zp_nat_inc_closed:
fixes n::nat
shows "[n] ⋅ 𝟭 ∈ carrier Zp"
by simp
lemma(in padic_integers) Zp_nat_mult_closed:
fixes n::nat
assumes "x ∈ carrier Zp"
shows "[n] ⋅ x ∈ carrier Zp"
by (simp add: assms)
lemma(in padic_integers) Zp_int_inc_closed:
fixes n::int
shows "[n] ⋅ 𝟭 ∈ carrier Zp"
by simp
lemma(in padic_integers) Zp_int_mult_closed:
fixes n::int
assumes "x ∈ carrier Zp"
shows "[n] ⋅ x ∈ carrier Zp"
by (simp add: assms)
text‹The following lemmas give a concrete description of the inclusion of integers and natural numbers into $\mathbb{Z}_p$:›
lemma(in padic_integers) Zp_nat_inc_rep:
fixes n::nat
shows "[n] ⋅ 𝟭 = (λ m. p_residue m n)"
apply(induction n)
apply (simp add: zero_rep)
proof-
case (Suc n)
fix n
assume A: "[n] ⋅ 𝟭 = (λm. p_residue m (int n))"
then have 0: "[Suc n] ⋅ 𝟭 = [n]⋅𝟭 ⊕ 𝟭" by auto
show "[Suc n] ⋅ 𝟭 = (λm. p_residue m (Suc n))"
proof fix m
show "([Suc n] ⋅ 𝟭) m = p_residue m (int (Suc n)) "
proof(cases "m=0")
case True
have 0: "([Suc n] ⋅ 𝟭) m ∈ carrier (Zp_res_ring m)"
using Zp_nat_inc_closed padic_set_res_closed
by (simp add: residues_closed)
then have "([Suc n] ⋅ 𝟭) m = 0"
using p_res_ring_0 True by blast
then show ?thesis
by (metis True p_res_ring_0' p_residue_range')
next
case False
then have R: "residues (p^m)"
by (simp add: prime residues_n)
have "([Suc n] ⋅ 𝟭) m = ([n]⋅𝟭 ⊕ 𝟭) m"
by (simp add: "0")
then have P0: "([Suc n] ⋅ 𝟭) m = p_residue m (int n) ⊕⇘Zp_res_ring m⇙ 𝟭⇘Zp_res_ring m⇙"
using A False Zp_def padic_add_res padic_one_def Zp_defs(5)
padic_integers.residue_of_one(1) padic_integers_axioms by auto
then have P1:"([Suc n] ⋅ 𝟭) m = p_residue m (int n) ⊕⇘Zp_res_ring m⇙ p_residue m (1::int)"
by (metis R ext p_residue_alt_def residue_add_assoc residue_add_comm residue_plus_zero_r
residue_times_one_r residue_times_zero_l residues.res_one_eq)
have P2: "p_residue m (int n) ⊕⇘Zp_res_ring m⇙ p_residue m 1 = ((int n) mod (p^m)) ⊕⇘Zp_res_ring m⇙ 1"
using R P0 P1 residue_def residues.res_one_eq
by (simp add: residues.res_one_eq p_residue_alt_def)
have P3:"((int n) mod (p^m)) ⊕⇘Zp_res_ring m⇙ 1 = ((int n) + 1) mod (p^m)"
using R residue_ring_def by (simp add: mod_add_left_eq)
have "p_residue m (int n) ⊕⇘Zp_res_ring m⇙ p_residue m 1 = (int (Suc n)) mod (p^m)"
by (metis P2 P3 add.commute of_nat_Suc p_residue_alt_def residue_add)
then show ?thesis
using False R P1 p_residue_def p_residue_alt_def
by auto
qed
qed
qed
lemma(in padic_integers) Zp_nat_inc_res:
fixes n::nat
shows "([n] ⋅ 𝟭) k = n mod (p^k)"
using Zp_nat_inc_rep p_residue_def
by (simp add: p_residue_alt_def)
lemma(in padic_integers) Zp_int_inc_rep:
fixes n::int
shows "[n] ⋅ 𝟭 = (λ m. p_residue m n )"
proof(induction n)
case (nonneg n)
then show ?case using Zp_nat_inc_rep
by (simp add: add_pow_int_ge)
next
case (neg n)
show "⋀n. [(- int (Suc n))] ⋅ 𝟭 = (λm. p_residue m (- int (Suc n)))"
proof
fix n
fix m
show "([(- int (Suc n))] ⋅ 𝟭) m = p_residue m (- int (Suc n))"
proof-
have "[(- int (Suc n))] ⋅ 𝟭 = ⊖ ([(int (Suc n))] ⋅ 𝟭)"
using a_inv_def abelian_group.a_group add_pow_def cring.axioms(1) domain_def
negative_zless_0 ring_def R.add.int_pow_neg R.one_closed by blast
then have "([(- int (Suc n))] ⋅ 𝟭) m = (⊖ ([(int (Suc n))] ⋅ 𝟭)) m"
by simp
have "𝟭 ∈ carrier Zp"
using cring.cring_simprules(6) domain_def by blast
have "([(int (Suc n))] ⋅ 𝟭) = ([(Suc n)] ⋅ 𝟭)"
by (metis add_pow_def int_pow_int)
then have "([(int (Suc n))] ⋅ 𝟭) ∈ carrier Zp" using Zp_nat_inc_closed
by simp
then have P0: "([(- int (Suc n))] ⋅ 𝟭) m = ⊖⇘Zp_res_ring m⇙ (([(int (Suc n))] ⋅ 𝟭) m)"
using Zp_def prime
using ‹[(- int (Suc n))] ⋅ 𝟭 = ⊖ ([int (Suc n)] ⋅ 𝟭)› padic_integers.Zp_residue_a_inv(1)
padic_integers_axioms by auto
have "(([(int (Suc n))] ⋅ 𝟭) m) = (p_residue m (Suc n))"
using Zp_nat_inc_rep by (simp add: add_pow_int_ge)
then have P1: "([(- int (Suc n))] ⋅ 𝟭) m = ⊖⇘Zp_res_ring m⇙(p_residue m (Suc n))"
using P0 by auto
have "⊖⇘Zp_res_ring m⇙(p_residue m (Suc n)) = p_residue m (- int (Suc n))"
proof(cases "m=0")
case True
then have 0:"⊖⇘Zp_res_ring m⇙(p_residue m (Suc n)) =⊖⇘Zp_res_ring 0⇙(p_residue 0 (Suc n))"
by blast
then have 1:"⊖⇘Zp_res_ring m⇙(p_residue m (Suc n)) =⊖⇘Zp_res_ring 0⇙ (p_residue 1 (Suc n))"
by (metis p_res_ring_0' residue_a_inv_closed)
then have 2:"⊖⇘Zp_res_ring m⇙(p_residue m (Suc n)) =⊖⇘Zp_res_ring 0⇙ 0"
by (metis p_res_ring_0' residue_a_inv_closed)
then have 3:"⊖⇘Zp_res_ring m⇙(p_residue m (Suc n)) =0"
using residue_1_prop p_res_ring_0' residue_a_inv_closed by presburger
have 4: "p_residue m (- int (Suc n)) ∈ carrier (Zp_res_ring 0)"
using p_res_ring_0 True residue_1_zero p_residue_range' by blast
then show ?thesis
using "3" True residue_1_zero
by (simp add: p_res_ring_0')
next
case False
then have R: "residues (p^m)"
using padic_integers.p_residues padic_integers_axioms by blast
have "⊖⇘Zp_res_ring m⇙ p_residue m (int (Suc n)) = ⊖⇘Zp_res_ring m⇙ (int (Suc n)) mod (p^m) "
using R residue_def residues.neg_cong residues.res_neg_eq p_residue_alt_def
by auto
then have "⊖⇘Zp_res_ring m⇙ p_residue m (int (Suc n)) = (-(int (Suc n))) mod (p^m)"
using R residues.res_neg_eq by auto
then show ?thesis
by (simp add: p_residue_alt_def)
qed
then show ?thesis
using P1 by linarith
qed
qed
qed
lemma(in padic_integers) Zp_int_inc_res:
fixes n::int
shows "([n] ⋅ 𝟭) k = n mod (p^k)"
using Zp_int_inc_rep p_residue_def
by (simp add: p_residue_alt_def)
abbreviation(in padic_integers)(input) 𝗉 where
"𝗉 ≡ [p] ⋅ 𝟭"
lemma(in padic_integers) p_natpow_prod:
"𝗉[^](n::nat) ⊗ 𝗉[^](m::nat) = 𝗉[^](n + m)"
by (simp add: R.nat_pow_mult)
lemma(in padic_integers) p_natintpow_prod:
assumes "(m::int) ≥ 0"
shows "𝗉[^](n::nat) ⊗ 𝗉[^]m = 𝗉[^](n + m)"
using p_natpow_prod[of n "nat m"] assms int_pow_def[of Zp 𝗉 m] int_pow_def[of Zp 𝗉 "n + m"]
by (metis (no_types, lifting) int_nat_eq int_pow_int of_nat_add)
lemma(in padic_integers) p_intnatpow_prod:
assumes "(n::int) ≥ 0"
shows "𝗉[^]n ⊗ 𝗉[^](m::nat) = 𝗉[^](m + n)"
using p_natintpow_prod[of n m] assms mult_comm[of "𝗉[^]n" "𝗉[^]m"]
by simp
lemma(in padic_integers) p_int_pow_prod:
assumes "(n::int) ≥ 0"
assumes "(m::int) ≥ 0"
shows "𝗉[^]n ⊗ 𝗉[^]m = 𝗉[^](m + n)"
proof-
have "nat n + nat m = nat (n + m)"
using assms
by (simp add: nat_add_distrib)
then have "𝗉 [^] (nat n + nat m) = 𝗉[^](n + m)"
using assms
by (simp add: ‹nat n + nat m = nat (n + m)›)
then show ?thesis using assms p_natpow_prod[of "nat n" "nat m"]
by (smt pow_nat)
qed
lemma(in padic_integers) p_natpow_prod_Suc:
"𝗉 ⊗ 𝗉[^](m::nat) = 𝗉[^](Suc m)"
"𝗉[^](m::nat) ⊗ 𝗉 = 𝗉[^](Suc m)"
using R.nat_pow_Suc2 R.nat_pow_Suc by auto
lemma(in padic_integers) power_residue:
assumes "a ∈ carrier Zp"
assumes "k > 0"
shows "(a[^]⇘Zp⇙ (n::nat)) k = (a k)^n mod (p^k)"
apply(induction n)
using p_residues assms(2) residue_of_one(1) residues.one_cong apply auto[1]
by (simp add: assms(1) mod_mult_left_eq power_commutes residue_of_prod')
section‹The Valuation on $\mathbb{Z}_p$›
subsection‹The Integer-Valued and Extended Integer-Valued Valuations›
fun fromeint :: "eint ⇒ int" where
"fromeint (eint x) = x"
text‹The extended-integer-valued $p$-adic valuation on $\mathbb{Z}_p$:›
definition(in padic_integers) val_Zp where
"val_Zp = (λx. (if (x = 𝟬) then (∞::eint) else (eint (padic_val p x))))"
text‹We also define an integer-valued valuation on the nonzero elements of $\mathbb{Z}_p$, for simplified reasoning›
definition(in padic_integers) ord_Zp where
"ord_Zp = padic_val p"
text‹Ord of additive inverse›
lemma(in padic_integers) ord_Zp_of_a_inv:
assumes "a ∈ nonzero Zp"
shows "ord_Zp a = ord_Zp (⊖a)"
using ord_Zp_def Zp_def assms
padic_val_a_inv prime
by (simp add: domain.nonzero_memE(1) padic_int_is_domain)
lemma(in padic_integers) val_Zp_of_a_inv:
assumes "a ∈ carrier Zp"
shows "val_Zp a = val_Zp (⊖a)"
using R.add.inv_eq_1_iff Zp_def assms padic_val_a_inv prime val_Zp_def by auto
text‹Ord-based criterion for being nonzero:›
lemma(in padic_integers) ord_of_nonzero:
assumes "x ∈carrier Zp"
assumes "ord_Zp x ≥0"
shows "x ≠ 𝟬"
"x ∈ nonzero Zp"
proof-
show "x ≠ 𝟬"
proof
assume "x = 𝟬"
then have "ord_Zp x = -1"
using ord_Zp_def padic_val_def Zp_def Zp_defs(2) by auto
then show False using assms(2) by auto
qed
then show "x ∈ nonzero Zp"
using nonzero_def assms(1)
by (simp add: nonzero_def)
qed
lemma(in padic_integers) not_nonzero_Zp:
assumes "x ∈ carrier Zp"
assumes "x ∉ nonzero Zp"
shows "x = 𝟬"
using assms(1) assms(2) nonzero_def by fastforce
lemma(in padic_integers) not_nonzero_Qp:
assumes "x ∈ carrier Q⇩p"
assumes "x ∉ nonzero Q⇩p"
shows "x = 𝟬⇘Q⇩p⇙"
using assms(1) assms(2) nonzero_def by force
text‹Relationship between val and ord›
lemma(in padic_integers) val_ord_Zp:
assumes "a ≠ 𝟬"
shows "val_Zp a = eint (ord_Zp a)"
by (simp add: assms ord_Zp_def val_Zp_def)
lemma(in padic_integers) ord_pos:
assumes "x ∈ carrier Zp"
assumes "x ≠ 𝟬"
shows "ord_Zp x ≥ 0"
proof-
have "x ≠padic_zero p"
using Zp_def assms(2) Zp_defs(2) by auto
then have "ord_Zp x = int (LEAST k. x (Suc k) ≠ 𝟬⇘residue_ring (p^Suc k)⇙)"
using ord_Zp_def padic_val_def by auto
then show ?thesis
by linarith
qed
lemma(in padic_integers) val_pos:
assumes "x ∈ carrier Zp"
shows "val_Zp x ≥ 0"
unfolding val_Zp_def using assms
by (metis (full_types) eint_0 eint_ord_simps(1) eint_ord_simps(3) ord_Zp_def ord_pos)
text‹For passing between nat and int castings of ord›
lemma(in padic_integers) ord_nat:
assumes "x ∈ carrier Zp"
assumes "x ≠𝟬"
shows "int (nat (ord_Zp x)) = ord_Zp x"
using ord_pos by (simp add: assms(1) assms(2))
lemma(in padic_integers) zero_below_ord:
assumes "x ∈ carrier Zp"
assumes "n ≤ ord_Zp x"
shows "x n = 0"
proof-
have "x n = 𝟬⇘residue_ring (p^n)⇙"
using ord_Zp_def zero_below_val Zp_def assms(1) assms(2) prime padic_int_simps(5)
by auto
then show ?thesis using residue_ring_def
by simp
qed
lemma(in padic_integers) zero_below_val_Zp:
assumes "x ∈ carrier Zp"
assumes "n ≤ val_Zp x"
shows "x n = 0"
by (metis assms(1) assms(2) eint_ord_simps(1) ord_Zp_def residue_of_zero(2) val_Zp_def zero_below_ord)
lemma(in padic_integers) below_ord_zero:
assumes "x ∈ carrier Zp"
assumes "x (Suc n) ≠ 0"
shows "n ≥ ord_Zp x"
proof-
have 0: "x ∈ padic_set p"
using Zp_def assms(1) Zp_defs(3)
by auto
have 1: "x (Suc n) ≠ 𝟬⇘residue_ring (p^(Suc n))⇙"
using residue_ring_def assms(2) by auto
have "of_nat n ≥ (padic_val p x )"
using 0 1 below_val_zero prime by auto
then show ?thesis using ord_Zp_def by auto
qed
lemma(in padic_integers) below_val_Zp_zero:
assumes "x ∈ carrier Zp"
assumes "x (Suc n) ≠ 0"
shows "n ≥ val_Zp x"
by (metis Zp_def assms(1) assms(2) eint_ord_simps(1) padic_integers.below_ord_zero
padic_integers.residue_of_zero(2) padic_integers.val_ord_Zp padic_integers_axioms)
lemma(in padic_integers) nonzero_imp_ex_nonzero_res:
assumes "x ∈ carrier Zp"
assumes "x ≠ 𝟬"
shows "∃k. x (Suc k) ≠ 0"
proof-
have 0: "x 0 = 0"
using Zp_def assms(1) padic_int_simps(5) padic_set_zero_res prime by auto
have "∃k. k > 0 ∧ x k ≠ 0"
apply(rule ccontr) using 0 Zp_defs unfolding padic_zero_def
by (metis assms(2) ext neq0_conv)
then show ?thesis
using not0_implies_Suc by blast
qed
lemma(in padic_integers) ord_suc_nonzero:
assumes "x ∈ carrier Zp"
assumes "x ≠𝟬"
assumes "ord_Zp x = n"
shows "x (Suc n) ≠ 0"
proof-
obtain k where k_def: "x (Suc k) ≠ 0"
using assms(1) nonzero_imp_ex_nonzero_res assms(2) by blast
then show ?thesis
using assms LeastI nonzero_imp_ex_nonzero_res unfolding ord_Zp_def padic_val_def
by (metis (mono_tags, lifting) Zp_defs(2) k_def of_nat_eq_iff padic_zero_def padic_zero_simp(1))
qed
lemma(in padic_integers) above_ord_nonzero:
assumes "x ∈ carrier Zp"
assumes "x ≠𝟬"
assumes "n > ord_Zp x"
shows "x n ≠ 0"
proof-
have P0: "n ≥ (Suc (nat (ord_Zp x)))"
by (simp add: Suc_le_eq assms(1) assms(2) assms(3) nat_less_iff ord_pos)
then have P1: "p_residue (Suc (nat (ord_Zp x))) (x n) = x (Suc (nat (ord_Zp x)))"
using assms(1) p_residue_padic_int by blast
then have P2: "p_residue (Suc (nat (ord_Zp x))) (x n) ≠ 0"
using Zp_def assms(1) assms(2) ord_nat padic_integers.ord_suc_nonzero
padic_integers_axioms by auto
then show ?thesis
using P0 P1 assms(1) p_residue_padic_int[of x "(Suc (nat (ord_Zp x)))" n] p_residue_def
by (metis ord_Zp_def padic_int_simps(2) padic_integers.zero_rep padic_integers_axioms padic_zero_simp(2))
qed
lemma(in padic_integers) ord_Zp_geq:
assumes "x ∈ carrier Zp"
assumes "x n = 0"
assumes "x ≠𝟬"
shows "ord_Zp x ≥ n"
proof(rule ccontr)
assume "¬ int n ≤ ord_Zp x"
then show False using assms
using above_ord_nonzero by auto
qed
lemma(in padic_integers) ord_equals:
assumes "x ∈ carrier Zp"
assumes "x (Suc n) ≠ 0"
assumes "x n = 0"
shows "ord_Zp x = n"
using assms(1) assms(2) assms(3) below_ord_zero ord_Zp_geq residue_of_zero(2)
by fastforce
lemma(in padic_integers) ord_Zp_p:
"ord_Zp 𝗉 = (1::int)"
proof-
have "ord_Zp 𝗉 = int 1"
apply(rule ord_equals[of 𝗉])
using Zp_int_inc_res[of p] prime_gt_1_int prime by auto
then show ?thesis
by simp
qed
lemma(in padic_integers) ord_Zp_one:
"ord_Zp 𝟭 = 0"
proof-
have "ord_Zp ([(1::int)]⋅𝟭) = int 0"
apply(rule ord_equals)
using Zp_int_inc_res[of 1] prime_gt_1_int prime by auto
then show ?thesis
by simp
qed
text‹ord is multiplicative on nonzero elements of Zp›
lemma(in padic_integers) ord_Zp_mult:
assumes "x ∈ nonzero Zp"
assumes "y ∈ nonzero Zp"
shows "(ord_Zp (x ⊗⇘Zp⇙ y)) = (ord_Zp x) + (ord_Zp y)"
using val_prod[of p x y] prime assms Zp_defs Zp_def nonzero_memE(2) ord_Zp_def
nonzero_closed nonzero_memE(2)
by auto
lemma(in padic_integers) ord_Zp_pow:
assumes "x ∈ nonzero Zp"
shows "ord_Zp (x[^](n::nat)) = n*(ord_Zp x)"
proof(induction n)
case 0
have "x[^](0::nat) = 𝟭"
using assms(1) nonzero_def by simp
then show ?case
by (simp add: ord_Zp_one)
next
case (Suc n)
fix n
assume IH: "ord_Zp (x [^] n) = int n * ord_Zp x "
have N: "(x [^] n) ∈ nonzero Zp"
proof-
have "ord_Zp x ≥ 0"
using assms
by (simp add: nonzero_closed nonzero_memE(2) ord_pos)
then have "ord_Zp (x [^] n) ≥ 0"
using IH assms by simp
then have 0: "(x [^] n) ≠ 𝟬"
using ord_of_nonzero(1) by force
have 1: "(x [^] n) ∈ carrier Zp"
by (simp add: nonzero_closed assms)
then show ?thesis
using "0" not_nonzero_Zp by blast
qed
have "x[^](Suc n) = x ⊗(x[^]n)"
using nonzero_closed assms R.nat_pow_Suc2 by blast
then have "ord_Zp (x[^](Suc n)) =(ord_Zp x) + ord_Zp (x[^]n)"
using N Zp_def assms padic_integers.ord_Zp_mult padic_integers_axioms by auto
then have "ord_Zp (x[^](Suc n)) =(ord_Zp x) +(int n * ord_Zp x)"
by (simp add: IH)
then have "ord_Zp (x[^](Suc n)) =(1*(ord_Zp x)) +(int n) * (ord_Zp x)"
by simp
then have "ord_Zp (x[^](Suc n)) =(1+ (int n)) * ord_Zp x"
by (simp add: comm_semiring_class.distrib)
then show "ord_Zp (x[^](Suc n)) = int (Suc n)*ord_Zp x"
by simp
qed
lemma(in padic_integers) val_Zp_pow:
assumes "x ∈ nonzero Zp"
shows "val_Zp (x[^](n::nat)) = (n*(ord_Zp x))"
using Zp_def domain.nat_pow_nonzero[of Zp] domain_axioms nonzero_memE assms ord_Zp_def
padic_integers.ord_Zp_pow padic_integers_axioms val_Zp_def
nonzero_memE(2)
by fastforce
lemma(in padic_integers) val_Zp_pow':
assumes "x ∈ nonzero Zp"
shows "val_Zp (x[^](n::nat)) = n*(val_Zp x)"
by (metis Zp_def assms not_nonzero_memI padic_integers.val_Zp_pow padic_integers.val_ord_Zp padic_integers_axioms times_eint_simps(1))
lemma(in padic_integers) ord_Zp_p_pow:
"ord_Zp (𝗉[^](n::nat)) = n"
using ord_Zp_pow ord_Zp_p Zp_def Zp_nat_inc_closed ord_of_nonzero(2) padic_integers_axioms int_inc_closed
Zp_int_inc_closed by auto
lemma(in padic_integers) ord_Zp_p_int_pow:
assumes "n ≥0"
shows "ord_Zp (𝗉[^](n::int)) = n"
by (metis assms int_nat_eq int_pow_int ord_Zp_def ord_Zp_p_pow)
lemma(in padic_integers) val_Zp_p:
"(val_Zp 𝗉) = 1"
using Zp_def ord_Zp_def padic_val_def val_Zp_def ord_Zp_p Zp_defs(2) one_eint_def
by auto
lemma(in padic_integers) val_Zp_p_pow:
"val_Zp (𝗉[^](n::nat)) = eint n"
proof-
have "(𝗉[^](n::nat)) ≠ 𝟬"
by (metis mult_zero_l n_not_Suc_n of_nat_eq_iff ord_Zp_def ord_Zp_p_pow p_natpow_prod_Suc(1))
then show ?thesis
using ord_Zp_p_pow by (simp add: ord_Zp_def val_Zp_def)
qed
lemma(in padic_integers) p_pow_res:
assumes "(n::nat) ≥ m"
shows "(𝗉[^]n) m = 0"
by (simp add: assms ord_Zp_p_pow zero_below_ord)
lemma(in padic_integers) p_pow_factor:
assumes "(n::nat) ≥ m"
shows "(h ⊗ (𝗉[^]n)) m = 0" "(h ⊗ (𝗉[^]n)) m = 𝟬⇘Zp_res_ring n⇙"
using assms p_pow_res p_res_ring_zero
by(auto simp: residue_of_zero Zp_residue_mult_zero(2))
subsection‹The Ultrametric Inequality›
text‹Ultrametric inequality for ord›
lemma(in padic_integers) ord_Zp_ultrametric:
assumes "x ∈ nonzero Zp"
assumes "y ∈ nonzero Zp"
assumes "x ⊕ y ∈ nonzero Zp"
shows "ord_Zp (x ⊕ y) ≥ min (ord_Zp x) (ord_Zp y)"
unfolding ord_Zp_def
using padic_val_ultrametric[of p x y] Zp_defs assms nonzero_memE Zp_def prime
nonzero_closed nonzero_memE(2) by auto
text‹Variants of the ultrametric inequality›
lemma (in padic_integers) ord_Zp_ultrametric_diff:
assumes "x ∈ nonzero Zp"
assumes "y ∈ nonzero Zp"
assumes "x ≠ y "
shows "ord_Zp (x ⊖ y) ≥ min (ord_Zp x) (ord_Zp y)"
using assms ord_Zp_ultrametric[of x "⊖ y"]
unfolding a_minus_def
by (metis (no_types, lifting) R.a_transpose_inv R.add.inv_closed R.add.m_closed R.l_neg nonzero_closed ord_Zp_of_a_inv ord_of_nonzero(2) ord_pos)
lemma(in padic_integers) ord_Zp_not_equal_imp_notequal:
assumes "x ∈ nonzero Zp"
assumes "y ∈ nonzero Zp"
assumes "ord_Zp x ≠ (ord_Zp y)"
shows "x ≠ y" "x ⊖ y ≠𝟬" "x ⊕ y ≠𝟬"
using assms
apply blast
using nonzero_closed assms(1) assms(2) assms(3) apply auto[1]
using nonzero_memE assms
using R.minus_equality nonzero_closed
Zp_def padic_integers.ord_Zp_of_a_inv
padic_integers_axioms by auto
lemma(in padic_integers) ord_Zp_ultrametric_eq:
assumes "x ∈ nonzero Zp"
assumes "y ∈ nonzero Zp"
assumes "ord_Zp x > (ord_Zp y)"
shows "ord_Zp (x ⊕ y) = ord_Zp y"
proof-
have 0: "ord_Zp (x ⊕ y) ≥ ord_Zp y"
using assms ord_Zp_not_equal_imp_notequal[of x y]
ord_Zp_ultrametric[of x y] nonzero_memE not_nonzero_Zp
nonzero_closed by force
have 1: "ord_Zp y ≥ min (ord_Zp(x ⊕ y)) (ord_Zp x)"
proof-
have 0: "x ⊕ y ≠ x"
using assms nonzero_memE
by (simp add: nonzero_closed nonzero_memE(2))
have 1: "x ⊕ y ∈ nonzero Zp"
using ord_Zp_not_equal_imp_notequal[of x y]
nonzero_closed assms(1) assms(2) assms(3)
not_nonzero_Zp by force
then show ?thesis
using 0 assms(1) assms(2) assms(3) ord_Zp_ultrametric_diff[of "x ⊕ y" x]
by (simp add: R.minus_eq nonzero_closed R.r_neg1 add_comm)
qed
then show ?thesis
using 0 assms(3)
by linarith
qed
lemma(in padic_integers) ord_Zp_ultrametric_eq':
assumes "x ∈ nonzero Zp"
assumes "y ∈ nonzero Zp"
assumes "ord_Zp x > (ord_Zp y)"
shows "ord_Zp (x ⊖ y) = ord_Zp y"
using assms ord_Zp_ultrametric_eq[of x "⊖ y"]
unfolding a_minus_def
by (metis R.add.inv_closed R.add.inv_eq_1_iff nonzero_closed not_nonzero_Zp ord_Zp_of_a_inv)
lemma(in padic_integers) ord_Zp_ultrametric_eq'':
assumes "x ∈ nonzero Zp"
assumes "y ∈ nonzero Zp"
assumes "ord_Zp x > (ord_Zp y)"
shows "ord_Zp (y ⊖ x) = ord_Zp y"
by (metis R.add.inv_closed R.minus_eq
nonzero_closed Zp_def add_comm
assms(1) assms(2) assms(3)
ord_Zp_of_a_inv ord_of_nonzero(2)
ord_pos padic_integers.ord_Zp_ultrametric_eq padic_integers_axioms)
lemma(in padic_integers) ord_Zp_not_equal_ord_plus_minus:
assumes "x ∈ nonzero Zp"
assumes "y ∈ nonzero Zp"
assumes "ord_Zp x ≠ (ord_Zp y)"
shows "ord_Zp (x ⊖ y) = ord_Zp (x ⊕ y)"
apply(cases "ord_Zp x > ord_Zp y")
using assms
apply (simp add: ord_Zp_ultrametric_eq ord_Zp_ultrametric_eq')
using assms nonzero_memI
by (smt add_comm ord_Zp_ultrametric_eq ord_Zp_ultrametric_eq'')
text‹val is multiplicative on nonzero elements›
lemma(in padic_integers) val_Zp_mult0:
assumes "x ∈ carrier Zp"
assumes "x ≠𝟬"
assumes "y ∈ carrier Zp"
assumes "y ≠𝟬"
shows "(val_Zp (x ⊗⇘Zp⇙ y)) = (val_Zp x) + (val_Zp y)"
apply(cases "x ⊗⇘Zp⇙ y = 𝟬")
using assms(1) assms(2) assms(3) assms(4) integral_iff val_ord_Zp ord_Zp_mult nonzero_memI
apply (simp add: integral_iff)
using assms ord_Zp_mult[of x y] val_ord_Zp
by (simp add: nonzero_memI)
text‹val is multiplicative everywhere›
lemma(in padic_integers) val_Zp_mult:
assumes "x ∈ carrier Zp"
assumes "y ∈ carrier Zp"
shows "(val_Zp (x ⊗⇘Zp⇙ y)) = (val_Zp x) + (val_Zp y)"
using assms(1) assms(2) integral_iff val_ord_Zp ord_Zp_mult nonzero_memI val_Zp_mult0 val_Zp_def
by simp
lemma(in padic_integers) val_Zp_ultrametric0:
assumes "x ∈ carrier Zp"
assumes "x ≠𝟬"
assumes "y ∈ carrier Zp"
assumes "y ≠𝟬"
assumes "x ⊕ y ≠ 𝟬"
shows "min (val_Zp x) (val_Zp y) ≤ val_Zp (x ⊕ y) "
apply(cases "x ⊕ y = 𝟬")
using assms apply blast
using assms ord_Zp_ultrametric[of x y] nonzero_memI val_ord_Zp[of x] val_ord_Zp[of y] val_ord_Zp[of "x ⊕ y"]
by simp
text‹Unconstrained ultrametric inequality›
lemma(in padic_integers) val_Zp_ultrametric:
assumes "x ∈ carrier Zp"
assumes "y ∈ carrier Zp"
shows " min (val_Zp x) (val_Zp y) ≤ val_Zp (x ⊕ y)"
apply(cases "x = 𝟬")
apply (simp add: assms(2))
apply(cases "y = 𝟬")
apply (simp add: assms(1))
apply(cases "x ⊕ y = 𝟬")
apply (simp add: val_Zp_def)
using assms val_Zp_ultrametric0[of x y]
by simp
text‹Variants of the ultrametric inequality›
lemma (in padic_integers) val_Zp_ultrametric_diff:
assumes "x ∈ carrier Zp"
assumes "y ∈ carrier Zp"
shows "val_Zp (x ⊖ y) ≥ min (val_Zp x) (val_Zp y)"
using assms val_Zp_ultrametric[of x "⊖y"] unfolding a_minus_def
by (metis R.add.inv_closed R.add.inv_eq_1_iff nonzero_memI ord_Zp_def ord_Zp_of_a_inv val_Zp_def)
lemma(in padic_integers) val_Zp_not_equal_imp_notequal:
assumes "x ∈ carrier Zp"
assumes "y ∈ carrier Zp"
assumes "val_Zp x ≠ val_Zp y"
shows "x ≠ y" "x ⊖ y ≠𝟬" "x ⊕ y ≠𝟬"
using assms(3) apply auto[1]
using assms(1) assms(2) assms(3) R.r_right_minus_eq apply blast
by (metis R.add.inv_eq_1_iff assms(1) assms(2) assms(3) R.minus_zero R.minus_equality
not_nonzero_Zp ord_Zp_def ord_Zp_of_a_inv val_ord_Zp)
lemma(in padic_integers) val_Zp_ultrametric_eq:
assumes "x ∈ carrier Zp"
assumes "y ∈ carrier Zp"
assumes "val_Zp x > val_Zp y"
shows "val_Zp (x ⊕ y) = val_Zp y"
apply(cases "x ≠ 𝟬 ∧ y ≠ 𝟬 ∧ x ≠ y")
using assms ord_Zp_ultrametric_eq[of x y] val_ord_Zp nonzero_memE
using not_nonzero_memE val_Zp_not_equal_imp_notequal(3) apply force
unfolding val_Zp_def
using assms(2) assms(3) val_Zp_def by force
lemma(in padic_integers) val_Zp_ultrametric_eq':
assumes "x ∈ carrier Zp"
assumes "y ∈ carrier Zp"
assumes "val_Zp x > (val_Zp y)"
shows "val_Zp (x ⊖ y) = val_Zp y"
using assms val_Zp_ultrametric_eq[of x "⊖ y"]
unfolding a_minus_def
by (metis R.add.inv_closed R.r_neg val_Zp_not_equal_imp_notequal(3))
lemma(in padic_integers) val_Zp_ultrametric_eq'':
assumes "x ∈ carrier Zp"
assumes "y ∈ carrier Zp"
assumes "val_Zp x > (val_Zp y)"
shows "val_Zp (y ⊖ x) = val_Zp y"
proof-
have 0: "y ⊖ x = ⊖ (x ⊖ y)"
using assms(1,2) unfolding a_minus_def
by (simp add: R.add.m_comm R.minus_add)
have 1: "val_Zp (x ⊖ y) = val_Zp y"
using assms val_Zp_ultrametric_eq' by blast
have 2: "val_Zp (x ⊖ y) = val_Zp (y ⊖ x)"
unfolding 0 unfolding a_minus_def
by(rule val_Zp_of_a_inv, rule R.ring_simprules, rule assms, rule R.ring_simprules, rule assms)
show ?thesis using 1 unfolding 2 by blast
qed
lemma(in padic_integers) val_Zp_not_equal_ord_plus_minus:
assumes "x ∈ carrier Zp"
assumes "y ∈ carrier Zp"
assumes "val_Zp x ≠ (val_Zp y)"
shows "val_Zp (x ⊖ y) = val_Zp (x ⊕ y)"
by (metis R.add.inv_closed R.minus_eq R.r_neg R.r_zero add_comm assms(1) assms(2) assms(3) not_nonzero_Zp ord_Zp_def ord_Zp_not_equal_ord_plus_minus val_Zp_def val_Zp_not_equal_imp_notequal(3))
subsection‹Units of $\mathbb{Z}_p$›
text‹Elements with valuation 0 in Zp are the units›
lemma(in padic_integers) val_Zp_0_criterion:
assumes "x ∈ carrier Zp"
assumes "x 1 ≠ 0"
shows "val_Zp x = 0"
unfolding val_Zp_def
using Zp_def assms(1) assms(2) ord_equals padic_set_zero_res prime
by (metis One_nat_def Zp_defs(3) of_nat_0 ord_Zp_def residue_of_zero(2) zero_eint_def)
text‹Units in Zp have val 0›
lemma(in padic_integers) unit_imp_val_Zp0:
assumes "x ∈ Units Zp"
shows "val_Zp x = 0"
apply(rule val_Zp_0_criterion)
apply (simp add: R.Units_closed assms)
using assms residue_of_prod[of x "inv x" 1] residue_of_one(2)[of 1] R.Units_r_inv[of x]
comm_monoid.UnitsI[of "R 1"] p_res_ring_1_field
by (metis le_eq_less_or_eq residue_of_prod residue_times_zero_r zero_le_one zero_neq_one)
text‹Elements in Zp with ord 0 are units›
lemma(in padic_integers) val_Zp0_imp_unit0:
assumes "val_Zp x = 0"
assumes "x ∈ carrier Zp"
fixes n::nat
shows "(x (Suc n)) ∈ Units (Zp_res_ring (Suc n))"
unfolding val_Zp_def
proof-
have p_res_ring: "residues (p^(Suc n))"
using p_residues by blast
have "⋀ n. coprime (x (Suc n)) p"
proof-
fix n
show "coprime (x (Suc n)) p"
proof-
have "¬ ¬ coprime (x (Suc n)) p"
proof
assume "¬ coprime (x (Suc n)) p"
then have "p dvd (x (Suc n))" using prime
by (meson coprime_commute prime_imp_coprime prime_nat_int_transfer)
then obtain k where "(x (Suc n)) = k*p"
by fastforce
then have S:"x (Suc n) mod p = 0"
by simp
have "x 1 = 0"
proof-
have "Suc n ≥ 1"
by simp
then have "x 1 = p_residue 1 (x (Suc n))"
using p_residue_padic_int assms(2) by presburger
then show ?thesis using S
by (simp add: p_residue_alt_def)
qed
have "x ≠𝟬"
proof-
have "ord_Zp x ≠ ord_Zp 𝟬"
using Zp_def ord_Zp_def padic_val_def assms(1) ord_of_nonzero(1) R.zero_closed
Zp_defs(2) val_Zp_def
by auto
then show ?thesis
by blast
qed
then have "x 1 ≠ 0"
using assms(1) assms(2) ord_suc_nonzero
unfolding val_Zp_def
by (simp add: ord_Zp_def zero_eint_def)
then show False
using ‹x 1 = 0› by blast
qed
then show ?thesis
by auto
qed
qed
then have "⋀ n. coprime (x (Suc n)) (p^(Suc n))"
by simp
then have "coprime (x (Suc n)) (p^(Suc n))"
by blast
then show ?thesis using assms residues.res_units_eq p_res_ring
by (metis (no_types, lifting) mod_pos_pos_trivial p_residue_ring_car_memE(1)
p_residue_ring_car_memE(2) residues.m_gt_one residues.mod_in_res_units residues_closed)
qed
lemma(in padic_integers) val_Zp0_imp_unit0':
assumes "val_Zp x = 0"
assumes "x ∈ carrier Zp"
assumes "(n::nat) > 0"
shows "(x n) ∈ Units (Zp_res_ring n)"
using assms val_Zp0_imp_unit0 gr0_implies_Suc by blast
lemma(in cring) ring_hom_Units_inv:
assumes "a ∈ Units R"
assumes "cring S"
assumes "h ∈ ring_hom R S"
shows "h (inv a) = inv⇘S⇙ h a" "h a ∈ Units S"
proof-
have 0:"h (inv a) ⊗⇘S⇙ h a = 𝟭⇘S⇙"
using assms Units_closed Units_inv_closed
by (metis (no_types, lifting) Units_l_inv ring_hom_mult ring_hom_one)
then show 1: "h (inv a) = inv⇘S⇙ h a"
by (metis Units_closed Units_inv_closed assms(1) assms(2) assms(3) comm_monoid.is_invI(1) cring_def ring_hom_closed)
show "h a ∈ Units S"
apply(rule comm_monoid.UnitsI[of S "inv⇘S⇙ h a"]) using 0 1 assms
using cring.axioms(2) apply blast
apply (metis "1" Units_inv_closed assms(1) assms(3) ring_hom_closed)
apply (meson Units_closed assms(1) assms(3) ring_hom_closed)
using "0" "1" by auto
qed
lemma(in padic_integers) val_Zp_0_imp_unit:
assumes "val_Zp x = 0"
assumes "x ∈ carrier Zp"
shows "x ∈ Units Zp"
proof-
obtain y where y_def: " y= (λn. (if n=0 then 0 else (m_inv (Zp_res_ring n) (x n))))"
by blast
have 0: "⋀m. m > 0 ⟹ y m = inv ⇘Zp_res_ring m⇙ (x m)"
using y_def by auto
have 1: "⋀m. m > 0 ⟹ inv⇘Zp_res_ring m⇙ (x m) ∈ carrier (Zp_res_ring m)"
proof- fix m::nat assume A: "m > 0" then show "inv⇘Zp_res_ring m⇙ (x m) ∈ carrier (Zp_res_ring m)"
using assms val_Zp0_imp_unit0' monoid.Units_inv_closed[of "Zp_res_ring m" "x m"]
by (smt One_nat_def Zp_def Zp_defs(2) cring.axioms(1) of_nat_0 ord_Zp_def
padic_integers.R_cring padic_integers.ord_suc_nonzero padic_integers.val_Zp_0_criterion padic_integers_axioms padic_val_def ring_def)
qed
have 2: "y ∈ padic_set p"
proof(rule padic_set_memI)
show 20: "⋀m. y m ∈ carrier (residue_ring (p ^ m))"
proof- fix m show "y m ∈ carrier (residue_ring (p ^ m))"
apply(cases "m = 0")
using y_def 0[of m] 1[of m]
by(auto simp: residue_ring_def y_def)
qed
show "⋀m n. m < n ⟹ residue (p ^ m) (y n) = y m"
proof- fix m n::nat assume A: "m < n"
show "residue (p ^ m) (y n) = y m"
proof(cases "m = 0")
case True
then show ?thesis
by (simp add: residue_1_zero y_def)
next
case False
have hom: "residue (p ^ m) ∈ ring_hom (Zp_res_ring n) (Zp_res_ring m)"
using A False prime residue_hom_p by auto
have inv: "y n = inv⇘Zp_res_ring n⇙ x n" using A
by (simp add: False y_def)
have unit: "x n ∈ Units (Zp_res_ring n)"
using A False Zp_def assms(1) assms(2) val_Zp0_imp_unit0' prime
by (metis gr0I gr_implies_not0)
have F0: "residue (p ^ m) (x n) = x m"
using A Zp_defs(3) assms(2) padic_set_res_coherent prime by auto
have F1: "residue (p ^ m) (y n) = inv⇘Zp_res_ring m⇙ x m"
using F0 R_cring A hom inv unit cring.ring_hom_Units_inv[of "Zp_res_ring n" "x n" "Zp_res_ring m" "residue (p ^ m)"]
False
by auto
then show ?thesis
by (simp add: False y_def)
qed
qed
qed
have 3: "y ⊗ x = 𝟭"
proof
fix m
show "(y ⊗ x) m = 𝟭 m"
proof(cases "m=0")
case True
then have L: "(y ⊗ x) m = 0"
using Zp_def "1" assms(2) Zp_residue_mult_zero(1) y_def
by auto
have R: "𝟭 m = 0"
by (simp add: True cring.cring_simprules(6) domain.axioms(1) ord_Zp_one zero_below_ord)
then show ?thesis using L R by auto
next
case False
have P: "(y ⊗ x) m = (y m) ⊗⇘residue_ring (p^m)⇙ (x m)"
using Zp_def residue_of_prod by auto
have "(y m) ⊗⇘residue_ring (p^m)⇙ (x m) = 1"
proof-
have "p^m > 1"
using False prime prime_gt_1_int by auto
then have "residues (p^m)"
using less_imp_of_nat_less residues.intro by fastforce
have "cring (residue_ring (p^m))"
using residues.cring ‹residues (p ^ m)›
by blast
then have M: "monoid (residue_ring (p^m))"
using cring_def ring_def by blast
have U: "(x m) ∈ Units (residue_ring (p^m))"
using False Zp_def assms(1) assms(2) padic_integers.val_Zp0_imp_unit0' padic_integers_axioms by auto
have I: "y m = m_inv (residue_ring (p^m)) (x m)"
by (simp add: False y_def)
have "(y m) ⊗⇘residue_ring (p^m)⇙ (x m) = 𝟭⇘residue_ring (p^m)⇙"
using M U I by (simp add: monoid.Units_l_inv)
then show ?thesis
using residue_ring_def by simp
qed
then show ?thesis
using P Zp_def False residue_of_one(2) by auto
qed
qed
have 4: "y ∈ carrier Zp"
using 2 Zp_defs by auto
show ?thesis
apply(rule R.UnitsI[of y])
using assms 4 3 by auto
qed
text‹Definition of ord on a fraction is independent of the choice of representatives›
lemma(in padic_integers) ord_Zp_eq_frac:
assumes "a ∈ nonzero Zp"
assumes "b ∈ nonzero Zp"
assumes "c ∈ nonzero Zp"
assumes "d ∈ nonzero Zp"
assumes "a ⊗ d = b ⊗ c"
shows "(ord_Zp a) - (ord_Zp b) = (ord_Zp c) - (ord_Zp d)"
proof-
have "ord_Zp (a ⊗ d) = ord_Zp (b ⊗ c)"
using assms
by presburger
then have "(ord_Zp a) + (ord_Zp d) = (ord_Zp b) + (ord_Zp c)"
using assms(1) assms(2) assms(3) assms(4) ord_Zp_mult by metis
then show ?thesis
by linarith
qed
lemma(in padic_integers) val_Zp_eq_frac_0:
assumes "a ∈ nonzero Zp"
assumes "b ∈ nonzero Zp"
assumes "c ∈ nonzero Zp"
assumes "d ∈ nonzero Zp"
assumes "a ⊗ d = b ⊗ c"
shows "(val_Zp a) - (val_Zp b) = (val_Zp c) - (val_Zp d)"
proof-
have 0:"(val_Zp a) - (val_Zp b) = (ord_Zp a) - (ord_Zp b)"
using assms nonzero_memE Zp_defs(2) ord_Zp_def val_Zp_def by auto
have 1: "(val_Zp c) - (val_Zp d) = (ord_Zp c) - (ord_Zp d)"
using assms nonzero_memE val_ord_Zp[of c] val_ord_Zp[of d]
by (simp add: nonzero_memE(2))
then show ?thesis
using "0" assms(1) assms(2) assms(3) assms(4) assms(5) ord_Zp_eq_frac
by presburger
qed
section‹Angular Component Maps on $\mathbb{Z}_p$›
text‹The angular component map on $\mathbb{Z}_p$ is just the map which normalizes a point $x \in \mathbb{Z}_p$ by mapping it to a point with valuation $0$. It is explicitly defined as the mapping $x \mapsto p^{-ord (p)}*x$ for nonzero $x$, and $0 \mapsto 0$. By composing these maps with reductions mod $p^n$ we get maps which are equal to the standard residue maps on units of $\mathbb{Z}_p$, but in general unequal elsewhere. Both the angular component map and the angular component map mod $p^n$ are homomorpshims from the multiplicative group of units of $\mathbb{Z}_p$ to the multiplicative group of units of the residue rings, and play a key role in first-order model-theoretic formalizations of the $p$-adics (see, for example \cite{10.2307/2274477}, or \cite{Denef1986}). ›
lemma(in cring) int_nat_pow_rep:
"[(k::int)]⋅𝟭 [^] (n::nat) = [(k^n)]⋅𝟭"
apply(induction n)
by (auto simp: add.int_pow_pow add_pow_rdistr_int mult.commute)
lemma(in padic_integers) p_pow_rep0:
fixes n::nat
shows "𝗉[^]n = [(p^n)]⋅𝟭"
using R.int_nat_pow_rep by auto
lemma(in padic_integers) p_pow_nonzero:
shows "(𝗉[^](n::nat)) ∈ carrier Zp"
"(𝗉[^](n::nat)) ≠ 𝟬"
apply simp
using Zp_def nat_pow_nonzero domain_axioms nonzero_memE int_inc_closed ord_Zp_p
padic_integers.ord_of_nonzero(2) padic_integers_axioms Zp_int_inc_closed
nonzero_memE(2)
by (metis ord_of_nonzero(2) zero_le_one)
lemma(in padic_integers) p_pow_nonzero':
shows "(𝗉[^](n::nat)) ∈ nonzero Zp"
using nonzero_def p_pow_nonzero
by (simp add: nonzero_def)
lemma(in padic_integers) p_pow_rep:
fixes n::nat
shows "(𝗉[^]n) k = (p^n) mod (p^k)"
by (simp add: R.int_nat_pow_rep Zp_int_inc_res)
lemma(in padic_integers) p_pow_car:
assumes " (n::int)≥ 0"
shows "(𝗉[^]n) ∈ carrier Zp"
proof-
have "(𝗉[^]n) = (𝗉[^](nat n))"
by (metis assms int_nat_eq int_pow_int)
then show ?thesis
by simp
qed
lemma(in padic_integers) p_int_pow_nonzero:
assumes "(n::int) ≥0"
shows "(𝗉[^]n) ∈ nonzero Zp"
by (metis assms not_nonzero_Zp ord_Zp_p_int_pow ord_of_nonzero(1) p_pow_car)
lemma(in padic_integers) p_nonzero:
shows "𝗉 ∈ nonzero Zp"
using p_int_pow_nonzero[of 1]
by (simp add: ord_Zp_p ord_of_nonzero(2))
text‹Every element of Zp is a unit times a power of p.›
lemma(in padic_integers) residue_factor_unique:
assumes "k>0"
assumes "x ∈ carrier Zp"
assumes "u ∈ carrier (Zp_res_ring k) ∧ (u* p^m) = (x (m+k))"
shows "u = (THE u. u ∈ carrier (Zp_res_ring k) ∧ (u* p^m) = (x (m+k)))"
proof-
obtain P where
P_def: "P = (λ u. u ∈ carrier (Zp_res_ring k) ∧ (u* p^m) = (x (m+k)))"
by simp
have 0: "P u"
using P_def assms(3) by blast
have 1: "⋀ v. P v ⟹ v = u"
by (metis P_def assms(3) mult_cancel_right
not_prime_0 power_not_zero prime)
have "u = (THE u. P u)"
by (metis 0 1 the_equality)
then show ?thesis using P_def
by blast
qed
lemma(in padic_integers) residue_factor_exists:
assumes "m = nat (ord_Zp x)"
assumes "k > 0"
assumes "x ∈ carrier Zp"
assumes "x ≠𝟬"
obtains u where "u ∈ carrier (Zp_res_ring k) ∧ (u* p^m) = (x (m+k))"
proof-
have X0: "(x (m+k)) ∈ carrier (Zp_res_ring (m+k)) "
using Zp_def assms(3) padic_set_res_closed residues_closed
by blast
then have X1: "(x (m+k)) ≥ 0"
using p_residues assms(2) residues.res_carrier_eq by simp
then have X2: "(x (m+k)) > 0"
using assms(1) assms(2) assms(3) assms(4) above_ord_nonzero
by (metis add.right_neutral add_cancel_right_right
add_gr_0 int_nat_eq less_add_same_cancel1
less_imp_of_nat_less not_gr_zero of_nat_0_less_iff of_nat_add ord_pos)
have 0: "x m = 0"
using Zp_def assms(1) assms(3) zero_below_val ord_nat zero_below_ord[of x m]
assms(4) ord_Zp_def by auto
then have 1: "x (m +k) mod p^m = 0"
using assms(2) assms(3) p_residue_padic_int residue_def
by (simp add: p_residue_alt_def)
then have "∃ u. u*(p^m) = (x (m+k))"
by auto
then obtain u where U0: " u*(p^m) = (x (m+k))"
by blast
have I: "(p^m) > 0 "
using prime
by (simp add: prime_gt_0_int)
then have U1: "(u* p^m) = (x (m+k))"
by (simp add: U0)
have U2: "u ≥ 0"
using I U1 X1
by (metis U0 less_imp_triv mult.right_neutral mult_less_cancel_left
of_nat_zero_less_power_iff power.simps(1) times_int_code(1))
have X3: "(x (m+k)) < p^(m+k)"
using assms(3) X0 p_residues assms(2) residues.res_carrier_eq by auto
have U3: "u < p^k"
proof(rule ccontr)
assume "¬ u < (p ^ k)"
then have "(p^k) ≤ u"
by simp
then have " (p^k * p^m) ≤ u*(p^m)"
using I by simp
then have "p^(m + k) ≤ (x (m+k))"
by (simp add: U0 add.commute semiring_normalization_rules(26))
then show False
using X3 by linarith
qed
then have "u ∈ carrier (Zp_res_ring k)"
using assms(2) p_residues residues.res_carrier_eq U3 U2 by auto
then show ?thesis using U1 that by blast
qed
definition(in padic_integers) normalizer where
"normalizer m x = (λk. if (k=0) then 0 else (THE u. u ∈ carrier (Zp_res_ring k) ∧ (u* p^m) = (x (m + k)) ) )"
definition(in padic_integers) ac_Zp where
"ac_Zp x = normalizer (nat (ord_Zp x)) x"
lemma(in padic_integers) ac_Zp_equation:
assumes "x ∈ carrier Zp"
assumes "x ≠𝟬"
assumes "k > 0"
assumes "m = nat (ord_Zp x)"
shows "(ac_Zp x k) ∈ carrier (Zp_res_ring k) ∧ (ac_Zp x k)*(p^m) = (x (m+k))"
proof-
have K0: "k >0"
using assms nat_neq_iff by blast
have KM: "m+ k > m"
using assms(3) assms(4) by linarith
obtain u where U0: "u ∈ carrier (Zp_res_ring k) ∧ (u* p^m) = (x (m+k))"
using assms(1) assms(2) assms(3) assms(4) residue_factor_exists by blast
have RHS: "ac_Zp x k = (THE u. u ∈ carrier (Zp_res_ring k) ∧ u*(p^m) = (x (m+k)))"
proof-
have K: "k ≠0"
by (simp add: K0)
have "ac_Zp x k = normalizer (nat (ord_Zp x)) x k"
using ac_Zp_def by presburger
then have "ac_Zp x k = normalizer m x k"
using assms by blast
then show "ac_Zp x k = (THE u. u ∈ carrier (Zp_res_ring k) ∧ (u* p^m) = (x (m + k)) ) "
using K unfolding normalizer_def p_residue_def
by simp
qed
have LHS:"u = (THE u. u ∈ carrier (Zp_res_ring k) ∧ u*(p^m) = (x (m+k)))"
using assms U0 K0 assms(1) residue_factor_unique[of k x u m] by metis
then have "u = ac_Zp x k"
by (simp add: RHS)
then show ?thesis using U0 by auto
qed
lemma(in padic_integers) ac_Zp_res:
assumes "m >k"
assumes "x ∈ carrier Zp"
assumes "x ≠𝟬"
shows "p_residue k (ac_Zp x m) = (ac_Zp x k)"
proof(cases "k =0")
case True
then show ?thesis
unfolding ac_Zp_def normalizer_def
by (meson p_res_ring_0' p_residue_range')
next
case False
obtain n where n_def: "n = nat (ord_Zp x)"
by blast
have K0: "k >0" using False by simp
obtain uk where Uk0: "uk = (ac_Zp x k)"
by simp
obtain um where Um0: "um = (ac_Zp x m)"
by simp
have Uk1: "uk ∈ carrier (Zp_res_ring k) ∧ uk*(p^n) = (x (n+k))"
using K0 Uk0 ac_Zp_equation assms(2) assms(3) n_def by metis
have Um1: "um ∈ carrier (Zp_res_ring m) ∧ um*(p^n) = (x (n+m))"
using Uk1 Um0 ac_Zp_equation assms(1) assms(3) n_def assms(2)
by (metis neq0_conv not_less0)
have "um mod (p^k) = uk"
proof-
have "(x (n+m)) mod (p^(n + k)) = (x (n+k))"
using assms(1) assms(3) p_residue_padic_int p_residue_def n_def
by (simp add: assms(2) p_residue_alt_def)
then have "(p^(n + k)) dvd (x (n+m)) - (x (n+k))"
by (metis dvd_minus_mod)
then obtain d where "(x (n+m)) - (x (n+k)) = (p^(n+k))*d"
using dvd_def by blast
then have "((um*(p^n)) - (uk*(p^n))) = p^(n+k)*d"
using Uk1 Um1 by auto
then have "((um - uk)*(p^n)) = p^(n+k)*d"
by (simp add: left_diff_distrib)
then have "((um - uk)*(p^n)) = ((p^k)*d)*(p^n)"
by (simp add: power_add)
then have "(um - uk) = ((p^k)*d)"
using prime by auto
then have "um mod p^k = uk mod p^k"
by (simp add: mod_eq_dvd_iff)
then show ?thesis using Uk1
by (metis mod_pos_pos_trivial p_residue_ring_car_memE(1) p_residue_ring_car_memE(2))
qed
then show ?thesis
by (simp add: Uk0 Um0 p_residue_alt_def)
qed
lemma(in padic_integers) ac_Zp_in_Zp:
assumes "x ∈ carrier Zp"
assumes "x ≠𝟬"
shows "ac_Zp x ∈ carrier Zp"
proof-
have "ac_Zp x ∈ padic_set p"
proof(rule padic_set_memI)
show "⋀m. ac_Zp x m ∈ carrier (residue_ring (p ^ m))"
proof-
fix m
show "ac_Zp x m ∈ carrier (residue_ring (p ^ m))"
proof(cases "m = 0")
case True
then have "ac_Zp x m = 0"
unfolding ac_Zp_def normalizer_def by auto
then show ?thesis
by (simp add: True residue_ring_def)
next
case False
then have "m>0"
by blast
then show ?thesis
using ac_Zp_equation
by (metis assms(1) assms(2))
qed
qed
show "⋀m n. m < n ⟹ residue (p ^ m) (ac_Zp x n) = ac_Zp x m"
using ac_Zp_res
by (simp add: assms(1) assms(2) p_residue_def)
qed
then show ?thesis
by (simp add: Zp_defs(3))
qed
lemma(in padic_integers) ac_Zp_is_Unit:
assumes "x ∈ carrier Zp"
assumes "x ≠𝟬"
shows "ac_Zp x ∈ Units Zp"
proof(rule val_Zp_0_imp_unit)
show "ac_Zp x ∈ carrier Zp"
by (simp add: ac_Zp_in_Zp assms(1) assms(2))
obtain m where M: "m = nat (ord_Zp x)"
by blast
have AC1: "(ac_Zp x 1)*(p^m) = (x (m+1))"
using M ac_Zp_equation assms(1) assms(2)
by (metis One_nat_def lessI)
have "(x (m+1)) ≠0"
using M assms
by (metis Suc_eq_plus1 Suc_le_eq nat_int nat_mono nat_neq_iff ord_Zp_geq)
then have "(ac_Zp x 1) ≠ 0"
using AC1 by auto
then show "val_Zp (ac_Zp x) = 0"
using ‹ac_Zp x ∈ carrier Zp› val_Zp_0_criterion
by blast
qed
text‹The typical defining equation for the angular component map.›
lemma(in padic_integers) ac_Zp_factors_x:
assumes "x ∈ carrier Zp"
assumes "x ≠𝟬"
shows "x = (𝗉[^](nat (ord_Zp x))) ⊗ (ac_Zp x)" "x = (𝗉[^](ord_Zp x)) ⊗ (ac_Zp x)"
proof-
show "x = (𝗉[^](nat (ord_Zp x)))⊗ (ac_Zp x)"
proof
fix k
show "x k = ((𝗉[^](nat (ord_Zp x))) ⊗ (ac_Zp x)) k"
proof(cases "k=0")
case True
then show ?thesis
using Zp_def Zp_defs(3) Zp_residue_mult_zero(1) ac_Zp_in_Zp
assms(1) assms(2) mult_comm padic_set_zero_res prime by auto
next
case False
show ?thesis
proof(cases "k ≤ ord_Zp x")
case True
have 0: "x k = 0"
using True assms(1) zero_below_ord by blast
have 1: "(𝗉[^](nat (ord_Zp x))) k = 0"
using True assms(1) assms(2) ord_Zp_p_pow ord_nat p_pow_nonzero(1) zero_below_ord
by presburger
have "((𝗉[^](nat (ord_Zp x))) ⊗ (ac_Zp x)) k = (𝗉[^](nat (ord_Zp x))) k * (ac_Zp x) k mod p^k"
using Zp_def padic_mult_res residue_ring_def
using residue_of_prod' by blast
then have "((𝗉[^](nat (ord_Zp x))) ⊗ (ac_Zp x)) k = 0"
by (simp add: "1")
then show ?thesis using 0
by metis
next
case False
obtain n where N: "n = nat (ord_Zp x)"
by metis
obtain m where M0: "k = n + m"
using False N le_Suc_ex ord_Zp_def by fastforce
have M1: "m >0"
using M0 False N assms(1) assms(2) ord_nat
by (metis Nat.add_0_right gr0I le_refl less_eq_int_code(1)
nat_eq_iff2 neq0_conv of_nat_eq_0_iff of_nat_mono)
have E1: "(ac_Zp x m)*(p^n) = (x k)"
using M0 M1 N ac_Zp_equation assms(1) assms(2) by blast
have E2: "(ac_Zp x k)*(p^n) = (x (n + k))"
using M0 M1 N ac_Zp_equation assms(1) assms(2) add_gr_0
by presburger
have E3: "((ac_Zp x k) mod (p^k))*((p^n) mod p^k) mod (p^k) = (x (n + k)) mod (p^k)"
by (metis E2 mod_mult_left_eq mod_mult_right_eq)
have E4: "((ac_Zp x k) mod (p^k))*(p^n) mod (p^k) = (x k)"
using E2 assms(1) le_add2 mod_mult_left_eq p_residue_padic_int p_residue_def
by (metis Zp_int_inc_rep Zp_int_inc_res)
have E5: "(ac_Zp x k)*((p^n) mod p^k) mod (p^k) = (x k)"
using E2 assms(1) p_residue_padic_int p_residue_def by (metis E3 E4 mod_mult_left_eq)
have E6: "(ac_Zp x k) ⊗⇘(Zp_res_ring k)⇙ ((p^n) mod p^k) = (x k)"
using E5 M0 M1 p_residues residues.res_mult_eq by auto
have E7: " ((p^n) mod p^k) ⊗⇘(Zp_res_ring k)⇙(ac_Zp x k) = (x k)"
by (simp add: E6 residue_mult_comm)
have E8: "((𝗉[^](nat (ord_Zp x))) k) ⊗⇘(Zp_res_ring k)⇙ (ac_Zp x k) = (x k)"
using E7 N p_pow_rep
by metis
then show ?thesis
by (simp add: residue_of_prod)
qed
qed
qed
then show "x = (𝗉[^](ord_Zp x)) ⊗ (ac_Zp x)"
by (metis assms(1) assms(2) int_pow_int ord_nat)
qed
lemma(in padic_integers) ac_Zp_factors':
assumes "x ∈ nonzero Zp"
shows "x = [p] ⋅ 𝟭 [^] ord_Zp x ⊗ ac_Zp x"
using assms nonzero_memE
by (simp add: nonzero_closed nonzero_memE(2) ac_Zp_factors_x(2))
lemma(in padic_integers) ac_Zp_mult:
assumes "x ∈ nonzero Zp"
assumes "y ∈ nonzero Zp"
shows "ac_Zp (x ⊗ y) = (ac_Zp x) ⊗ (ac_Zp y)"
proof-
have P0: "x = (𝗉[^](nat (ord_Zp x))) ⊗ (ac_Zp x)"
using nonzero_memE ac_Zp_factors_x assms(1)
by (simp add: nonzero_closed nonzero_memE(2))
have P1: "y = (𝗉[^](nat (ord_Zp y))) ⊗ (ac_Zp y)"
using nonzero_memE ac_Zp_factors_x assms(2)
by (simp add: nonzero_closed nonzero_memE(2))
have "x ⊗ y = (𝗉[^](nat (ord_Zp (x ⊗ y)))) ⊗ (ac_Zp (x ⊗ y))"
proof-
have "x ⊗ y ∈ nonzero Zp"
by (simp add: assms(1) assms(2) nonzero_mult_closed)
then show ?thesis
using nonzero_closed nonzero_memE(2) Zp_def
padic_integers.ac_Zp_factors_x(1) padic_integers_axioms
by blast
qed
then have "x ⊗ y = (𝗉[^](nat ((ord_Zp x) + (ord_Zp y)))) ⊗ (ac_Zp (x ⊗ y))"
using assms ord_Zp_mult[of x y]
by (simp add: Zp_def)
then have "x ⊗ y = (𝗉[^]((nat (ord_Zp x)) + nat (ord_Zp y))) ⊗ (ac_Zp (x ⊗ y))"
using nonzero_closed nonzero_memE(2) assms(1) assms(2)
nat_add_distrib ord_pos by auto
then have "x ⊗ y = (𝗉[^](nat (ord_Zp x))) ⊗ (𝗉[^](nat(ord_Zp y))) ⊗ (ac_Zp (x ⊗ y))"
using p_natpow_prod
by metis
then have P2: "(𝗉[^](nat (ord_Zp x))) ⊗ (𝗉[^](nat(ord_Zp y))) ⊗ (ac_Zp (x ⊗ y))
= ((𝗉[^](nat (ord_Zp x))) ⊗ (ac_Zp x)) ⊗ ((𝗉[^](nat (ord_Zp y))) ⊗ (ac_Zp y))"
using P0 P1
by metis
have "(𝗉[^](nat (ord_Zp x))) ⊗ (𝗉[^](nat(ord_Zp y))) ⊗ (ac_Zp (x ⊗ y))
= ((𝗉[^](nat (ord_Zp x))) ⊗ ((𝗉[^](nat (ord_Zp y))) ⊗ (ac_Zp x)) ⊗ (ac_Zp y))"
by (metis P0 P1 Zp_def ‹x ⊗ y = [p] ⋅ 𝟭 [^] nat (ord_Zp x) ⊗ [p] ⋅ 𝟭 [^] nat (ord_Zp y) ⊗ ac_Zp (x ⊗ y)›
mult_comm padic_integers.mult_assoc padic_integers_axioms)
then have "((𝗉[^](nat (ord_Zp x))) ⊗ (𝗉[^](nat(ord_Zp y)))) ⊗ (ac_Zp (x ⊗ y))
=((𝗉[^](nat (ord_Zp x))) ⊗ (𝗉[^](nat(ord_Zp y)))) ⊗ ((ac_Zp x) ⊗ (ac_Zp y))"
using Zp_def mult_assoc by auto
then show ?thesis
by (metis (no_types, lifting) R.m_closed
‹x ⊗ y = [p] ⋅ 𝟭 [^] nat (ord_Zp x) ⊗ [p] ⋅ 𝟭 [^] nat (ord_Zp y) ⊗ ac_Zp (x ⊗ y)›
ac_Zp_in_Zp assms(1) assms(2) integral_iff m_lcancel
nonzero_closed nonzero_memE(2) p_pow_nonzero(1))
qed
lemma(in padic_integers) ac_Zp_one:
"ac_Zp 𝟭 = 𝟭"
by (metis R.one_closed Zp_def ac_Zp_factors_x(2) int_pow_0 ord_Zp_one padic_integers.ac_Zp_in_Zp padic_integers_axioms padic_one_id prime zero_not_one)
lemma(in padic_integers) ac_Zp_inv:
assumes "x ∈ Units Zp"
shows "ac_Zp (inv⇘Zp⇙ x) = inv⇘Zp⇙ (ac_Zp x)"
proof-
have "x ⊗ (inv⇘Zp⇙ x) = 𝟭"
using assms by simp
then have "(ac_Zp x) ⊗ (ac_Zp (inv⇘Zp⇙ x)) = ac_Zp 𝟭"
using ac_Zp_mult[of x "(inv x)"] R.Units_nonzero
assms zero_not_one by auto
then show ?thesis
using R.invI(2)[of "(ac_Zp x)" "(ac_Zp (inv⇘Zp⇙ x))"] assms ac_Zp_in_Zp ac_Zp_one
by (metis (no_types, lifting) R.Units_closed R.Units_inv_closed
R.Units_r_inv integral_iff R.inv_unique ac_Zp_is_Unit)
qed
lemma(in padic_integers) ac_Zp_of_Unit:
assumes "val_Zp x = 0"
assumes "x ∈ carrier Zp"
shows "ac_Zp x = x"
using assms unfolding val_Zp_def
by (metis R.one_closed Zp_def ac_Zp_factors_x(2) ac_Zp_one eint.inject infinity_ne_i0 mult_assoc
ord_Zp_def ord_Zp_one padic_integers.ac_Zp_in_Zp padic_integers_axioms padic_one_id prime zero_eint_def zero_not_one)
lemma(in padic_integers) ac_Zp_p:
"(ac_Zp 𝗉) = 𝟭"
proof-
have 0: "𝗉 = 𝗉 [^] nat (ord_Zp 𝗉) ⊗ ac_Zp 𝗉"
using ac_Zp_factors_x[of 𝗉] ord_Zp_p ord_of_nonzero(1)
by auto
have 1: "𝗉 [^] nat (ord_Zp 𝗉) = 𝗉"
by (metis One_nat_def nat_1 ord_Zp_p p_pow_rep0 power_one_right)
then have 2: "𝗉 = 𝗉 ⊗ ac_Zp 𝗉"
using "0" by presburger
have "ac_Zp 𝗉 ∈ carrier Zp"
using ac_Zp_in_Zp[of 𝗉]
by (simp add: ord_Zp_p ord_of_nonzero(1))
then show ?thesis
by (metis "1" "2" m_lcancel R.one_closed R.r_one
Zp_int_inc_closed p_pow_nonzero(2))
qed
lemma(in padic_integers) ac_Zp_p_nat_pow:
"(ac_Zp (𝗉 [^] (n::nat))) = 𝟭"
apply(induction n)
apply (simp add: ac_Zp_one)
using ac_Zp_mult ac_Zp_p int_nat_pow_rep nat_pow_Suc2 R.nat_pow_one
R.one_closed p_natpow_prod_Suc(1) p_nonzero p_pow_nonzero' p_pow_rep0
by auto
text‹Facts for reasoning about integer powers in an arbitrary commutative monoid:›
lemma(in monoid) int_pow_add:
fixes n::int
fixes m::int
assumes "a ∈ Units G"
shows "a [^] (n + m) = (a [^] n) ⊗ (a [^] m)"
proof-
have 0: "group (units_of G)"
by (simp add: units_group)
have 1: "a ∈ carrier (units_of G)"
by (simp add: assms units_of_carrier)
have "⋀n::int. a [^] n = a [^]⇘units_of G⇙ n"
proof- fix k::int show "a [^] k = a [^]⇘units_of G⇙ k" using 1 assms units_of_pow
by (metis Units_pow_closed int_pow_def nat_pow_def units_of_inv units_of_pow)
qed
have 2: "a [^]⇘units_of G⇙ (n + m) = (a [^]⇘units_of G⇙ n) ⊗⇘units_of G⇙ (a [^]⇘units_of G⇙ m)"
by (simp add: "1" group.int_pow_mult units_group)
show ?thesis using 0 1 2
by (simp add: ‹⋀n. a [^] n = a [^]⇘units_of G⇙ n› units_of_mult)
qed
lemma(in monoid) int_pow_unit_closed:
fixes n::int
assumes "a ∈ Units G"
shows "a[^] n ∈ Units G"
apply(cases "n ≥ 0")
using units_of_def[of G] units_group Units_inv_Units[of a]
Units_pow_closed[of "inv a"] Units_pow_closed[of a]
apply (metis assms pow_nat)
using units_of_def[of G] units_group Units_inv_Units[of a]
Units_pow_closed[of "inv a"] Units_pow_closed[of a]
by (simp add: assms int_pow_def nat_pow_def)
lemma(in monoid) nat_pow_of_inv:
fixes n::nat
assumes "a ∈ Units G"
shows "inv a[^] n = inv (a[^] n)"
by (metis (no_types, hide_lams) Units_inv_Units Units_inv_closed Units_inv_inv Units_pow_closed
Units_r_inv assms inv_unique' nat_pow_closed nat_pow_one pow_mult_distrib)
lemma(in monoid) int_pow_of_inv:
fixes n::int
assumes "a ∈ Units G"
shows "inv a[^] n = inv (a[^] n)"
apply(cases "n ≥0")
apply (metis assms nat_pow_of_inv pow_nat)
by (metis assms int_pow_def2 nat_pow_of_inv)
lemma(in monoid) int_pow_inv:
fixes n::int
assumes "a ∈ Units G"
shows "a[^] -n = inv a[^] n"
apply(cases "n =0")
apply simp
apply(cases "n > 0")
using int_pow_def2[of G a "-n"] int_pow_of_inv
apply (simp add: assms)
using assms int_pow_def2[of G a "-n"] int_pow_def2[of G a "n"] int_pow_def2[of G "inv a"]
int_pow_of_inv[of a n] Units_inv_Units[of a] Units_inv_inv Units_pow_closed[of a]
by (metis linorder_not_less nat_0_iff nat_eq_iff2 nat_zero_as_int neg_0_less_iff_less)
lemma(in monoid) int_pow_inv':
fixes n::int
assumes "a ∈ Units G"
shows "a[^] -n = inv (a[^] n)"
by (simp add: assms int_pow_inv int_pow_of_inv)
lemma(in comm_monoid) inv_of_prod:
assumes "a ∈ Units G"
assumes "b ∈ Units G"
shows "inv (a ⊗ b) = (inv a) ⊗ (inv b)"
by (metis Units_m_closed assms(1) assms(2) comm_monoid.m_comm comm_monoid_axioms
group.inv_mult_group monoid.Units_inv_closed monoid_axioms units_group
units_of_carrier units_of_inv units_of_mult)
section‹Behaviour of $val\_Zp$ and $ord\_Zp$ on Natural Numbers and Integers›
text‹If f and g have an equal residue at k, then they differ by a multiple of $p^k$.›
lemma(in padic_integers) eq_residue_mod:
assumes "f ∈ carrier Zp"
assumes "g ∈ carrier Zp"
assumes "f k = g k"
shows "∃h. h ∈ carrier Zp ∧ f = g ⊕ (𝗉[^]k)⊗h"
proof(cases "f = g")
case True
then show ?thesis
using Zp_int_inc_zero' assms(1) by auto
next
case False
have "(f ⊖ g) k = 0"
using assms
by (metis R.r_right_minus_eq residue_of_diff residue_of_zero(2))
then have "ord_Zp (f ⊖ g) ≥ k"
using False assms
by (simp add: ord_Zp_geq)
then obtain m::int where m_def: "m ≥ 0 ∧ ord_Zp (f ⊖ g) = k + m"
using zle_iff_zadd by auto
have "f ⊖ g = 𝗉[^](k + m) ⊗ ac_Zp (f ⊖ g)"
using ac_Zp_factors_x(2)[of "f ⊖ g"] False m_def assms(1) assms(2) by auto
then have 0: "f ⊖ g = 𝗉[^]k ⊗ 𝗉 [^] m ⊗ ac_Zp (f ⊖ g)"
by (simp add: Zp_def m_def padic_integers.p_natintpow_prod padic_integers_axioms)
have "𝗉[^]k ⊗ 𝗉 [^] m ⊗ ac_Zp (f ⊖ g) ∈ carrier Zp"
using assms "0" by auto
then have "f = g ⊕ 𝗉[^]k ⊗ 𝗉 [^] m ⊗ ac_Zp (f ⊖ g)"
using 0 assms R.ring_simprules
by simp
then show ?thesis using mult_assoc
by (metis "0" False R.m_closed R.r_right_minus_eq ‹[p] ⋅ 𝟭 [^] k ⊗ [p] ⋅ 𝟭 [^] m ⊗ ac_Zp (f ⊖ g) ∈ carrier Zp› ac_Zp_in_Zp assms(1) assms(2) m_def p_pow_car)
qed
lemma(in padic_integers) eq_residue_mod':
assumes "f ∈ carrier Zp"
assumes "g ∈ carrier Zp"
assumes "f k = g k"
obtains h where "h ∈ carrier Zp ∧ f = g ⊕ (𝗉[^]k)⊗h"
using assms eq_residue_mod by meson
text‹Valuations of integers which do not divide $p$:›
lemma(in padic_integers) ord_Zp_p_nat_unit:
assumes "(n::nat) mod p ≠ 0"
shows "ord_Zp ([n]⋅𝟭) = 0"
using ord_equals[of "[n]⋅𝟭" "0::nat"]
by (simp add: Zp_nat_inc_res assms)
lemma(in padic_integers) val_Zp_p_nat_unit:
assumes "(n::nat) mod p ≠ 0"
shows "val_Zp ([n]⋅𝟭) = 0"
unfolding val_Zp_def
using assms ord_Zp_def ord_Zp_p_nat_unit ord_of_nonzero(1) zero_eint_def by auto
lemma(in padic_integers) nat_unit:
assumes "(n::nat) mod p ≠ 0"
shows "([n]⋅𝟭) ∈ Units Zp "
using Zp_nat_mult_closed val_Zp_p_nat_unit
by (simp add: assms val_Zp_0_imp_unit ord_Zp_p_nat_unit)
lemma(in padic_integers) ord_Zp_p_int_unit:
assumes "(n::int) mod p ≠ 0"
shows "ord_Zp ([n]⋅𝟭) = 0"
by (metis One_nat_def Zp_int_inc_closed Zp_int_inc_res assms mod_by_1 of_nat_0 ord_equals power_0 power_one_right)
lemma(in padic_integers) val_Zp_p_int_unit:
assumes "(n::int) mod p ≠ 0"
shows "val_Zp ([n]⋅𝟭) = 0"
unfolding val_Zp_def
using assms ord_Zp_def ord_Zp_p_int_unit ord_of_nonzero(1) zero_eint_def by auto
lemma(in padic_integers) int_unit:
assumes "(n::int) mod p ≠ 0"
shows "([n]⋅𝟭) ∈ Units Zp "
by (simp add: assms val_Zp_0_imp_unit val_Zp_p_int_unit)
lemma(in padic_integers) int_decomp_ord:
assumes "n = l*(p^k)"
assumes "l mod p ≠ 0"
shows "ord_Zp ([n]⋅𝟭) = k"
proof-
have 0: "n = l * (p^k)"
using assms(1)
by simp
then have "(l * (p ^ k) mod (p ^ (Suc k))) ≠ 0"
using Zp_def Zp_nat_inc_zero assms(2) p_nonzero nonzero_memE
padic_integers_axioms R.int_inc_zero nonzero_memE(2) by auto
then have 3: "(l * p ^ k) mod (p ^ (Suc k)) ≠ 0"
by presburger
show ?thesis
using "0" "3" Zp_int_inc_res ord_equals by auto
qed
lemma(in padic_integers) int_decomp_val:
assumes "n = l*(p^k)"
assumes "l mod p ≠ 0"
shows "val_Zp ([n]⋅𝟭) = k"
using Zp_def assms(1) assms(2) R.int_inc_closed ord_of_nonzero(1) int_decomp_ord padic_integers_axioms val_ord_Zp
by auto
text‹$\mathbb{Z}_p$ has characteristic zero:›
lemma(in padic_integers) Zp_char_0:
assumes "(n::int) > 0"
shows "[n]⋅𝟭 ≠ 𝟬"
proof-
have "prime (nat p)"
using prime prime_nat_iff_prime
by blast
then obtain l0 k where 0: "nat n = l0*((nat p)^k) ∧ ¬ (nat p) dvd l0 "
using prime assms prime_power_canonical[of "nat p" "nat n"]
by auto
obtain l where l_def: "l = int l0"
by blast
have 1: "n = l*(p^k) ∧ ¬ p dvd l "
using 0 l_def
by (smt assms int_dvd_int_iff int_nat_eq of_nat_mult of_nat_power prime prime_gt_0_int)
show ?thesis
apply(cases "l = 1")
using 1 p_pow_nonzero(2) p_pow_rep0 apply auto[1]
using 1 by (simp add: dvd_eq_mod_eq_0 int_decomp_ord ord_of_nonzero(1))
qed
lemma(in padic_integers) Zp_char_0':
assumes "(n::nat) > 0"
shows "[n]⋅𝟭 ≠ 𝟬"
proof-
have "[n]⋅𝟭 = [(int n)]⋅𝟭"
using assms
by (simp add: add_pow_def int_pow_int)
then show ?thesis using assms Zp_char_0[of "int n"]
by simp
qed
lemma (in domain) not_eq_diff_nonzero:
assumes "a ≠ b"
assumes "a ∈ carrier R"
assumes "b ∈carrier R"
shows "a ⊖ b ∈ nonzero R"
by (simp add: nonzero_def assms(1) assms(2) assms(3))
lemma (in domain) minus_a_inv:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "a ⊖ b = ⊖ (b ⊖ a)"
by (simp add: add.inv_mult_group assms(1) assms(2) minus_eq)
lemma(in ring) plus_diff_simp:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
assumes "c ∈ carrier R"
assumes "X = a ⊖ b"
assumes "Y = c ⊖ a"
shows "X ⊕ Y = c ⊖ b"
using assms
unfolding a_minus_def
using ring_simprules
by (simp add: r_neg r_neg2)
lemma (in padic_integers) Zp_residue_eq:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "val_Zp (a ⊖ b) > k"
shows "(a k) = (b k)"
proof-
have 0: "(a ⊖ b) k = a k ⊖⇘Zp_res_ring k⇙ b k"
using assms
by (simp add: residue_of_diff)
have 1: "(a ⊖ b) k = 0"
using assms zero_below_val
by (smt R.minus_closed Zp_def eint_ord_simps(2) padic_integers.p_res_ring_zero
padic_integers.residue_of_zero(1) padic_integers.val_ord_Zp padic_integers.zero_below_ord padic_integers_axioms)
show ?thesis
apply(cases "k = 0")
apply (metis assms(1) assms(2) p_res_ring_0' residues_closed)
using 0 1 assms p_residues R_cring Zp_def assms(1) assms(2) cring_def padic_set_res_closed
residues.res_zero_eq ring.r_right_minus_eq
by (metis Zp_defs(3) linorder_neqE_nat not_less0 p_res_ring_zero)
qed
lemma (in padic_integers) Zp_residue_eq2:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "(a k) = (b k)"
assumes "a ≠ b"
shows "val_Zp (a ⊖ b) ≥ k"
proof-
have "(a ⊖ b) k = 0"
using assms residue_of_diff
by (simp add: Zp_def padic_integers.residue_of_diff' padic_integers_axioms)
then show ?thesis
using assms(1) assms(2) ord_Zp_def ord_Zp_geq val_Zp_def by auto
qed
lemma (in padic_integers) equal_val_Zp:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "c ∈ carrier Zp"
assumes "val_Zp a = val_Zp b"
assumes "val_Zp (c ⊖ a) > val_Zp b"
shows "val_Zp c = val_Zp b"
proof-
have 0: "val_Zp c = val_Zp (c ⊖ a ⊕ a)"
using assms
by (simp add: R.l_neg R.minus_eq add_assoc)
have "val_Zp c ≥ min (val_Zp (c ⊖ a)) (val_Zp a)"
using val_Zp_ultrametric[of "(c ⊖ a)" a] assms(1)
assms(3) ord_Zp_ultrametric_eq''
by (simp add: "0")
then have 1: "val_Zp c ≥ (val_Zp a)"
by (metis assms(4) assms(5) dual_order.order_iff_strict less_le_trans min_le_iff_disj)
have "val_Zp c = (val_Zp a)"
proof(rule ccontr)
assume A: "val_Zp c ≠ val_Zp a"
then have 0: "val_Zp c > val_Zp a"
using 1 A by auto
then have "val_Zp (c ⊕ (a ⊖ c)) ≥ min (val_Zp c) (val_Zp (a ⊖ c))"
by (simp add: assms(1) assms(3) val_Zp_ultrametric)
then have 1: "val_Zp a ≥ min (val_Zp c) (val_Zp (a ⊖ c))"
using assms(1) assms(3) assms(4) assms(5) val_Zp_ultrametric_eq' 0 by auto
have 2: "val_Zp (a ⊖ c) > val_Zp a"
using "0" assms(1) assms(3) assms(4) assms(5)
val_Zp_ultrametric_eq' by auto
then have "val_Zp a > val_Zp a"
using 0 1 2 val_Zp_of_a_inv
by (metis assms(1) assms(3) assms(4) assms(5) val_Zp_ultrametric_eq')
then show False
by blast
qed
then show ?thesis
using assms(4)
by simp
qed
lemma (in padic_integers) equal_val_Zp':
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "c ∈ carrier Zp"
assumes "val_Zp a = val_Zp b"
assumes "val_Zp c > val_Zp b"
shows "val_Zp (a ⊕ c) = val_Zp b"
proof-
have 0: "val_Zp b < val_Zp (a ⊕ c ⊖ a)"
by (simp add: R.minus_eq nonzero_closed R.r_neg1 add_comm assms(1) assms(3) assms(5))
have 1: "val_Zp a ≠ val_Zp (⊖ c)"
using assms(3) assms(4) assms(5)
by (metis eq_iff not_less val_Zp_of_a_inv)
then show ?thesis
by (meson "0" R.semiring_axioms assms(1) assms(2) assms(3) assms(4) equal_val_Zp semiring.semiring_simprules(1))
qed
lemma (in padic_integers) val_Zp_of_minus:
assumes "a ∈ carrier Zp"
shows "val_Zp a = val_Zp (⊖ a)"
using assms not_nonzero_Zp ord_Zp_def ord_Zp_of_a_inv val_Zp_def
by auto
end
Theory Padic_Int_Topology
theory Padic_Int_Topology
imports Padic_Integers Function_Ring
begin
type_synonym padic_int_seq = "nat ⇒ padic_int"
type_synonym padic_int_fun = "padic_int ⇒ padic_int"
sublocale padic_integers < FunZp?: U_function_ring "Zp"
unfolding U_function_ring_def
by (simp add: R.ring_axioms)
context padic_integers
begin
section‹Sequences over Zp›
text‹
The $p$-adic valuation can be thought of as equivalent to the $p$-adic absolute value, but with
the notion of size inverted so that small numbers have large valuation, and zero has maximally
large valuation. The $p$-adic distance between two points is just the valuation of the difference
of those points, and is thus equivalent to the metric induced by the $p$-adic absolute value.
For background on valuations and absolute values for $p$-adic rings see \cite{engler2005valued}.
In what follows, we develop the topology of the $p$-adic from a valuative perspective rather than
a metric perspective. Though equivalent to the metric approach in the $p$-adic case, this
approach is more general in that there exist valued rings whose valuations take values in
non-Archimedean ordered ablelian groups which do not embed into the real numbers.
›
subsection‹The Valuative Distance Function on $\mathbb{Z}_p$›
text‹
The following lemmas establish that the $p$-adic distance function satifies the standard
properties of an ultrametric. It is symmetric, obeys the ultrametric inequality, and only
identical elements are infinitely close.
›
definition val_Zp_dist :: "padic_int ⇒ padic_int ⇒ eint" where
"val_Zp_dist a b ≡ val_Zp (a ⊖ b)"
lemma val_Zp_dist_sym:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
shows "val_Zp_dist a b = val_Zp_dist b a"
proof-
have 1: "a ⊖ b = ⊖ (b ⊖ a)" using assms(1) assms(2)
using minus_a_inv by blast
then show ?thesis
using R.minus_closed Zp_def assms(1) assms(2) padic_integers.val_Zp_of_minus
padic_integers_axioms val_Zp_dist_def by auto
qed
lemma val_Zp_dist_ultrametric:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "c ∈ carrier Zp"
shows "val_Zp_dist b c ≥ min (val_Zp_dist a c) (val_Zp_dist a b)"
proof-
let ?X = "b ⊖ a"
let ?Y = "a ⊖ c"
let ?Z = "b ⊖ c"
have 0: "?Z = ?X ⊕ ?Y"
using R.add.m_comm assms(1) assms(2) assms(3) R.plus_diff_simp by auto
have 4: "val_Zp ?Z ≥ min (val_Zp ?X) (val_Zp ?Y)"
using "0" assms(1) assms(2) assms(3) val_Zp_ultrametric by auto
then show ?thesis
using assms val_Zp_dist_sym
unfolding val_Zp_dist_def
by (simp add: min.commute)
qed
lemma val_Zp_dist_infty:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "val_Zp_dist a b = ∞"
shows "a = b"
using assms unfolding val_Zp_dist_def
by (metis R.r_right_minus_eq not_eint_eq val_ord_Zp)
lemma val_Zp_dist_infty':
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "a = b"
shows "val_Zp_dist a b = ∞"
using assms unfolding val_Zp_dist_def
by (simp add: val_Zp_def)
text‹
The following property will be useful in the proof of Hensel's Lemma: two $p$-adic integers are
close together if and only if their residues are equal at high orders.
›
lemma val_Zp_dist_res_eq:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "val_Zp_dist a b > k"
shows "(a k) = (b k)"
using assms(1) assms(2) assms(3) val_Zp_dist_def
by (simp add: Zp_residue_eq)
lemma val_Zp_dist_res_eq2:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "(a k) = (b k)"
shows "val_Zp_dist a b ≥ k"
using assms(1) assms(2) assms(3) Zp_residue_eq2
unfolding val_Zp_dist_def
by (simp add: val_Zp_def)
lemma val_Zp_dist_triangle_eqs:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "c ∈ carrier Zp"
assumes "val_Zp_dist a b > n"
assumes "val_Zp_dist a c > n"
assumes "(k::nat) < n"
shows "a k = b k"
"a k = c k"
"b k = c k"
unfolding val_Zp_dist_def
proof-
show 0: "a k = b k"
using assms(1) assms(2) assms(4) assms(6) val_Zp_dist_res_eq
by (metis less_imp_le_nat p_residue_padic_int)
show 1: "a k = c k"
using assms(1) assms(3) assms(5) assms(6) val_Zp_dist_res_eq
by (meson eint_ord_simps(1) le_less_trans less_imp_triv not_less of_nat_le_iff)
show "b k = c k"
using 0 1 by auto
qed
subsection‹Cauchy Sequences›
text‹
The definition of Cauchy sequence here is equivalent to standard the metric notion, and is
identical to the one found on page 50 of \cite{engler2005valued}.
›
lemma closed_seqs_diff_closed:
assumes "s ∈ closed_seqs Zp"
assumes "a ∈ carrier Zp"
shows "s m ⊖ a ∈ carrier Zp"
using assms
by (simp add: closed_seqs_memE)
definition is_Zp_cauchy :: "padic_int_seq ⇒ bool" where
"is_Zp_cauchy s = ((s ∈ closed_seqs Zp) ∧ (∀ (n::int). ∃ (N::nat). ∀ m k::nat.
(m>N ∧ k>N ⟶ (val_Zp_dist (s m) (s k)) > eint n)))"
text‹Relation for a sequence which converges to a point:›
definition Zp_converges_to :: "padic_int_seq ⇒ padic_int ⇒ bool" where
"Zp_converges_to s a = ((a ∈ carrier Zp ∧ s ∈ closed_seqs Zp)
∧ (∀(n::int). (∃(k:: nat). (∀( m::nat).
(m > k ⟶ (val_Zp ((s m) ⊖ a)) > eint n) ))))"
lemma is_Zp_cauchy_imp_closed:
assumes "is_Zp_cauchy s"
shows "s ∈ closed_seqs Zp"
using assms unfolding is_Zp_cauchy_def by blast
text‹
Analogous to the lemmas about residues and $p$-adic distances, we can characterize Cauchy
sequences without reference to a distance function: a sequence is Cauchy if and only if for
every natural number $k$, the $k^{th}$ residues of the elements in the sequence are eventually
all equal.
›
lemma is_Zp_cauchy_imp_res_eventually_const_0:
assumes "is_Zp_cauchy s"
fixes n::nat
obtains N where "⋀ n0 n1. n0 > N ∧ n1 > N ⟹ (s n0) n = (s n1) n"
proof-
have "∃ (N::nat). ∀ m k::nat. (m>N ∧ k>N ⟶ (val_Zp_dist (s m) (s k)) > (int n))"
using assms is_Zp_cauchy_def by blast
then obtain N where P0: " ∀ m k::nat. (m>N ∧ k>N ⟶ (val_Zp_dist (s m) (s k)) > (int n))"
by blast
have P1: "⋀ n0 n1. n0 > N ∧ n1 > N ⟹ (s n0) n = (s n1) n"
proof-
fix n0 n1
assume A: "n0 > N ∧ n1 > N"
have "(n0>N ∧ n1>N ⟶ (val_Zp_dist (s n0) (s n1)) > (int n))"
using P0 by blast
then have C0: "(val_Zp_dist (s n0) (s n1)) > (int n)"
using A by blast
show "(s n0) n = (s n1) n"
proof-
have A0: "(val_Zp_dist (s n0) (s n1)) > (int n)"
using C0 by blast
have A1: "s n0 ∈ carrier Zp"
using is_Zp_cauchy_imp_closed[of s] assms
by (simp add: closed_seqs_memE)
have A2: "s n1 ∈ carrier Zp"
using is_Zp_cauchy_def assms closed_seqs_memE[of _ Zp]
by blast
show ?thesis
using A0 val_Zp_dist_res_eq A1 A2 by metis
qed
qed
then show ?thesis
using that by blast
qed
lemma is_Zp_cauchyI:
assumes "s ∈ closed_seqs Zp"
assumes "⋀ n. (∃N. (∀ n0 n1. n0 > N ∧ n1 > N ⟶ (s n0) n = (s n1) n))"
shows "is_Zp_cauchy s"
proof-
have "(∀ (n::int). ∃ (N::nat). ∀ m k::nat. (m>N ∧ k>N ⟶ (val_Zp_dist (s m) (s k)) > n))"
proof
fix n
show "∃ (N::nat). ∀ m k::nat. (m>N ∧ k>N ⟶ (val_Zp_dist (s m) (s k)) > eint n)"
proof-
have "(∃N. (∀ n0 n1. n0 > N ∧ n1 > N ⟶ (s n0) (Suc (nat n)) = (s n1) (Suc (nat n))))"
using assms(2) by blast
then obtain N where N_def: "(∀ n0 n1. n0 > N ∧ n1 > N ⟶ (s n0) (Suc (nat n)) = (s n1) (Suc (nat n)))"
by blast
have 0: "n ≤ eint (int (nat n))"
by simp
have "∀m k. N < m ∧ N < k ⟶ (nat n) < val_Zp_dist (s m) (s k)"
proof
fix m
show "∀k. N < m ∧ N < k ⟶ int (nat n) < val_Zp_dist (s m) (s k)"
proof
fix k
show "N < m ∧ N < k ⟶ int(nat n) < val_Zp_dist (s m) (s k)"
proof
assume A: "N < m ∧ N < k"
then have E: "(s m) (Suc(nat n)) = (s k) (Suc(nat n))"
using N_def by blast
then show " int (nat n) < val_Zp_dist (s m) (s k)"
proof-
have 0: "(s m) ∈ carrier Zp"
by (simp add: assms(1) closed_seqs_memE)
have 1: "(s k) ∈ carrier Zp"
using Zp_def assms(1) closed_seqs_memE[of _ Zp] padic_integers_axioms by blast
have "int (Suc (nat n)) ≤ val_Zp_dist (s m) (s k)"
using E 0 1 val_Zp_dist_res_eq[of "(s m)" "(s k)" "Suc (nat n)"] val_Zp_dist_res_eq2
by blast
then have "int (nat n) < val_Zp_dist (s m) (s k)"
by (metis Suc_ile_eq add.commute of_nat_Suc)
then show ?thesis
by blast
qed
qed
qed
qed
hence "∀m k. N < m ∧ N < k ⟶ n < val_Zp_dist (s m) (s k)"
using 0
by (simp add: order_le_less_subst2)
thus ?thesis by blast
qed
qed
then show ?thesis
using is_Zp_cauchy_def assms by blast
qed
lemma is_Zp_cauchy_imp_res_eventually_const:
assumes "is_Zp_cauchy s"
fixes n::nat
obtains N r where "r ∈ carrier (Zp_res_ring n)" and "⋀ m. m > N ⟹ (s m) n = r"
proof-
obtain N where A0: "⋀ n0 n1. n0 > N ∧ n1 > N ⟹ (s n0) n = (s n1) n"
using assms is_Zp_cauchy_imp_res_eventually_const_0 padic_integers_axioms by blast
obtain r where A1: "s (Suc N) n = r"
by simp
have 0: "r ∈ carrier (Zp_res_ring n)"
using Zp_def ‹s (Suc N) n = r› assms closed_seqs_memE[of _ Zp]
is_Zp_cauchy_def padic_integers_axioms residues_closed
by blast
have 1: "⋀ m. m > N ⟹ (s m) n = r"
proof-
fix m
assume " m > N"
then show "(s m) n = r"
using A0 A1 by blast
qed
then show ?thesis
using 0 1 that by blast
qed
text‹
This function identifies the eventual residues of the elements of a cauchy sequence.
Since a $p$-adic integer is defined to be the map which identifies its residues, this map
will turn out to be precisely the limit of a cauchy sequence.
›
definition res_lim :: "padic_int_seq ⇒ padic_int" where
"res_lim s = (λ k. (THE r. (∃N. (∀ m. m > N ⟶ (s m) k = r))))"
lemma res_lim_Zp_cauchy_0:
assumes "is_Zp_cauchy s"
assumes "f = (res_lim s) k"
shows "(∃N. (∀ m. (m > N ⟶ (s m) k = f)))"
"f ∈ carrier (Zp_res_ring k)"
proof-
obtain N r where P0: "r ∈ carrier (Zp_res_ring k)" and P1: "⋀ m. m > N ⟹ (s m) k = r"
by (meson assms(1) is_Zp_cauchy_imp_res_eventually_const)
obtain P where P_def: "P = (λ x. (∃N. (∀ m. m > N ⟶ (s m) k = x)))"
by simp
have 0: "P r"
using P1 P_def by auto
have 1: "(⋀x. P x ⟹ x = r)"
proof-
fix x
assume A_x: "P x"
obtain N0 where "(∀ m. m > N0 ⟶ (s m) k = x)"
using A_x P_def by blast
let ?M = "max N0 N"
have C0: "s (Suc ?M) k = x"
by (simp add: ‹∀m>N0. s m k = x›)
have C1: "s (Suc ?M) k = r"
by (simp add: P1)
show "x = r"
using C0 C1 by auto
qed
have R: "r = (THE x. P x)"
using the_equality 0 1 by metis
have "(res_lim s) k = (THE r. ∃N. ∀m>N. s m k = r)"
using res_lim_def by simp
then have "f = (THE r. ∃N. ∀m>N. s m k = r)"
using assms by auto
then have "f = (THE r. P r)"
using P_def by auto
then have "r = f"
using R by auto
then show "(∃N. (∀ m. (m > N ⟶ (s m) k = f)))" using 0 P_def
by blast
show "f ∈ carrier (Zp_res_ring k)"
using P0 ‹r = f› by auto
qed
lemma res_lim_Zp_cauchy:
assumes "is_Zp_cauchy s"
obtains N where "⋀ m. (m > N ⟶ (s m) k = (res_lim s) k)"
using res_lim_Zp_cauchy_0 assms by presburger
lemma res_lim_in_Zp:
assumes "is_Zp_cauchy s"
shows "res_lim s ∈ carrier Zp"
proof-
have "res_lim s ∈ padic_set p"
proof(rule padic_set_memI)
show "⋀m. res_lim s m ∈ carrier (residue_ring (p^ m))"
using res_lim_Zp_cauchy_0 by (simp add: assms)
show "⋀m n. m < n ⟹ residue (p^ m) (res_lim s n) = res_lim s m"
proof-
fix m n
obtain N where N0: "⋀ l. (l > N ⟶ (s l) m = (res_lim s) m)"
using assms res_lim_Zp_cauchy by blast
obtain M where M0: "⋀ l. (l > M ⟶ (s l) n = (res_lim s) n)"
using assms prod.simps(2) res_lim_Zp_cauchy by auto
obtain K where K_def: "K = max M N"
by simp
have Km: "⋀ l. (l > K ⟶ (s l) m = (res_lim s) m)"
using K_def N0 by simp
have Kn: "⋀ l. (l > K ⟶ (s l) n = (res_lim s) n)"
using K_def M0 by simp
assume "m < n"
show "residue (p^ m) (res_lim s n) = res_lim s m"
proof-
obtain l where l_def: "l = Suc K"
by simp
have ln: "(res_lim s n) = (s l) n"
by (simp add: Kn l_def)
have lm: "(res_lim s m) = (s l) m"
by (simp add: Km l_def)
have s_car: "s l ∈ carrier Zp"
using assms is_Zp_cauchy_def closed_seqs_memE[of _ Zp] by blast
then show ?thesis
using s_car lm ln ‹m < n› p_residue_def p_residue_padic_int by auto
qed
qed
qed
then show ?thesis
by (simp add: Zp_def padic_int_simps(5))
qed
subsection‹Completeness of $\mathbb{Z}_p$›
text‹
We can use the developments above to show that a sequence of $p$-adic integers is convergent
if and only if it is cauchy, and that limits of convergent sequences are always unique.
›
lemma is_Zp_cauchy_imp_has_limit:
assumes "is_Zp_cauchy s"
assumes "a = res_lim s"
shows "Zp_converges_to s a"
proof-
have 0: "(a ∈ carrier Zp ∧ s ∈ closed_seqs Zp)"
using assms(1) assms(2) is_Zp_cauchy_def res_lim_in_Zp by blast
have 1: "(∀(n::int). (∃(k:: nat). (∀( m::nat).
(m > k ⟶ (val_Zp ((s m) ⊖ a)) ≥ n))))"
proof
fix n
show "∃k. ∀m>k. eint n ≤ val_Zp (s m ⊖ a)"
proof-
obtain K where K_def: "⋀m. (m > K ⟶ (s m) (nat n) = (res_lim s) (nat n))"
using assms(1) res_lim_Zp_cauchy
by blast
have "∀m>K. n ≤ val_Zp_dist (s m) a"
proof
fix m
show "K < m ⟶ n ≤ val_Zp_dist (s m) a"
proof
assume A: "K < m"
show " n ≤ val_Zp_dist (s m) a"
proof-
have X: "(s m) ∈ carrier Zp"
using "0" closed_seqs_memE[of _ Zp]
by blast
have "(s m) (nat n) = (res_lim s) (nat n)"
using A K_def by blast
then have "(s m) (nat n) = a (nat n)"
using assms(2) by blast
then have "int (nat n) ≤ val_Zp_dist (s m) a"
using X val_Zp_dist_res_eq2 "0" by blast
then show ?thesis
by (metis eint_ord_simps(1) int_ops(1) less_not_sym nat_eq_iff2 not_le order_trans zero_eint_def)
qed
qed
qed
then show ?thesis
using val_Zp_dist_def by auto
qed
qed
then show ?thesis using
"0" Zp_converges_to_def
by (metis Suc_ile_eq val_Zp_dist_def)
qed
lemma convergent_imp_Zp_cauchy:
assumes "s ∈ closed_seqs Zp"
assumes "a ∈ carrier Zp"
assumes "Zp_converges_to s a"
shows "is_Zp_cauchy s"
apply(rule is_Zp_cauchyI)
using assms apply simp
proof-
fix n
show "∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ s n0 n = s n1 n "
proof-
obtain k where k_def:"∀m>k. n < val_Zp_dist (s m) a"
using assms val_Zp_dist_def
unfolding Zp_converges_to_def
by presburger
have A0: "∀n0 n1. k < n0 ∧ k < n1 ⟶ s n0 n = s n1 n "
proof- have "⋀n0 n1. k < n0 ∧ k < n1 ⟶ s n0 n = s n1 n"
proof
fix n0 n1
assume A: " k < n0 ∧ k < n1"
show " s n0 n = s n1 n "
proof-
have 0: "n < val_Zp_dist (s n0) a"
using k_def using A
by blast
have 1: "n < val_Zp_dist (s n1) a"
using k_def using A
by blast
hence 2: "(s n0) n = a n"
using 0 assms val_Zp_dist_res_eq[of "s n0" a n] closed_seqs_memE
by blast
hence 3: "(s n1) n = a n"
using 1 assms val_Zp_dist_res_eq[of "s n1" a n] closed_seqs_memE
by blast
show ?thesis
using 2 3
by auto
qed
qed
thus ?thesis by blast
qed
show ?thesis
using A0
by blast
qed
qed
lemma unique_limit:
assumes "s ∈ closed_seqs Zp"
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "Zp_converges_to s a"
assumes "Zp_converges_to s b"
shows "a = b"
proof-
have "⋀k. a k = b k"
proof-
fix k::nat
obtain k0 where k0_def:"∀m>k0. k < val_Zp_dist (s m) a"
using assms unfolding val_Zp_dist_def Zp_converges_to_def
by blast
obtain k1 where k1_def:"∀m>k1. k < val_Zp_dist (s m) b"
using assms unfolding val_Zp_dist_def Zp_converges_to_def
by blast
have k0_prop: "⋀m. m> k0 ⟹ (s m) k = a k" proof- fix m assume A: "m > k0"
then show "(s m) k = a k"
using k0_def assms closed_seqs_memE[of s Zp] val_Zp_dist_res_eq[of _ a k] of_nat_Suc
by blast
qed
have k1_prop: "⋀m. m> k1 ⟹ (s m) k = b k"
using k1_def assms closed_seqs_memE[of s Zp]
by (simp add: val_Zp_dist_res_eq)
have "⋀ m. m > (max k0 k1) ⟹ a k = b k"
using k0_prop k1_prop
by force
then show "a k = b k"
by blast
qed
then show ?thesis
by blast
qed
lemma unique_limit':
assumes "s ∈ closed_seqs Zp"
assumes "a ∈ carrier Zp"
assumes "Zp_converges_to s a"
shows "a = res_lim s"
using unique_limit[of s a "res_lim s"] assms
convergent_imp_Zp_cauchy is_Zp_cauchy_imp_has_limit res_lim_in_Zp
by blast
lemma Zp_converges_toE:
assumes "s ∈ closed_seqs Zp"
assumes "a ∈ carrier Zp"
assumes "Zp_converges_to s a"
shows "∃N. ∀k > N. s k n = a n"
by (metis assms(1) assms(2) assms(3)
convergent_imp_Zp_cauchy
res_lim_Zp_cauchy unique_limit')
lemma Zp_converges_toI:
assumes "s ∈ closed_seqs Zp"
assumes "a ∈ carrier Zp"
assumes "⋀n. ∃N. ∀k > N. s k n = a n"
shows "Zp_converges_to s a"
proof-
have 0: "(a ∈ carrier Zp ∧ s ∈ closed_seqs Zp)"
using assms
by auto
have 1: "(∀n::int. ∃k. ∀m>k. n < val_Zp_dist (s m) a) "
proof
fix n::int
show "∃k. ∀m>k. n < val_Zp_dist (s m) a "
proof(cases "n < 0")
case True
have "∀m>0. n < val_Zp_dist (s m) a "
proof
fix m ::nat
show "0 < m ⟶ n < val_Zp_dist (s m) a"
proof
have 0: "eint n < 0"
by (simp add: True zero_eint_def)
have 1: " s m ⊖ a ∈ carrier Zp"
using assms
by (simp add: closed_seqs_diff_closed)
thus " n < val_Zp_dist (s m) a"
using 0 True val_pos[of "s m ⊖ a"]
unfolding val_Zp_dist_def
by auto
qed
qed
then show ?thesis
by blast
next
case False
then have P0: "n ≥ 0"
by auto
obtain N where N_def: "∀k > N. s k (Suc (nat n)) = a (Suc (nat n))"
using assms by blast
have "∀m>N. n < val_Zp_dist (s m) a "
proof
fix m
show " N < m ⟶ n < val_Zp_dist (s m) a"
proof
assume A: "N < m"
then have A0: "s m (Suc (nat n)) = a (Suc (nat n))"
using N_def by blast
have "(Suc (nat n)) ≤ val_Zp_dist (s m) a"
using assms A0 val_Zp_dist_res_eq2[of "s m" a "Suc (nat n)"] closed_seqs_memE
by blast
thus "n < val_Zp_dist (s m) a"
using False
by (meson P0 eint_ord_simps(2) less_Suc_eq less_le_trans nat_less_iff)
qed
qed
then show ?thesis
by blast
qed
qed
show ?thesis
unfolding Zp_converges_to_def
using 0 1
by (simp add: val_Zp_dist_def)
qed
text‹Sums and products of cauchy sequences are cauchy:›
lemma sum_of_Zp_cauchy_is_Zp_cauchy:
assumes "is_Zp_cauchy s"
assumes "is_Zp_cauchy t"
shows "is_Zp_cauchy (s ⊕⇘Zp⇗ω⇖⇙ t)"
proof(rule is_Zp_cauchyI)
show "(s ⊕⇘Zp⇗ω⇖⇙ t) ∈ closed_seqs Zp"
using assms seq_plus_closed is_Zp_cauchy_def by blast
show "⋀n. ∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ (s ⊕⇘Zp⇗ω⇖⇙ t) n0 n = (s ⊕⇘Zp⇗ω⇖⇙ t) n1 n"
proof-
fix n
show "∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ (s ⊕⇘Zp⇗ω⇖⇙ t) n0 n = (s ⊕⇘Zp⇗ω⇖⇙ t) n1 n"
proof-
obtain N1 where N1_def: "∀n0 n1. N1 < n0 ∧ N1 < n1 ⟶ s n0 n = s n1 n"
using assms(1) is_Zp_cauchy_imp_res_eventually_const_0 padic_integers_axioms by blast
obtain N2 where N2_def: "∀n0 n1. N2 < n0 ∧ N2 < n1 ⟶ t n0 n = t n1 n"
using assms(2) is_Zp_cauchy_imp_res_eventually_const_0 padic_integers_axioms by blast
obtain M where M_def: "M = max N1 N2"
by simp
have "∀n0 n1. M < n0 ∧ M < n1 ⟶ (s ⊕⇘Zp⇗ω⇖⇙ t) n0 n = (s ⊕⇘Zp⇗ω⇖⇙ t) n1 n"
proof
fix n0
show "∀n1. M < n0 ∧ M < n1 ⟶ (s ⊕⇘Zp⇗ω⇖⇙ t) n0 n = (s ⊕⇘Zp⇗ω⇖⇙ t) n1 n"
proof
fix n1
show " M < n0 ∧ M < n1 ⟶ (s ⊕⇘Zp⇗ω⇖⇙ t) n0 n = (s ⊕⇘Zp⇗ω⇖⇙ t) n1 n"
proof
assume A: "M < n0 ∧ M < n1 "
have Fs: " s n0 n = s n1 n" using A M_def N1_def by auto
have Ft: " t n0 n = t n1 n" using A M_def N2_def by auto
then show "(s ⊕⇘Zp⇗ω⇖⇙ t) n0 n = (s ⊕⇘Zp⇗ω⇖⇙ t) n1 n"
using seq_plus_simp[of s t] assms
by (simp add: Fs is_Zp_cauchy_imp_closed residue_of_sum)
qed
qed
qed
then show ?thesis
by blast
qed
qed
qed
lemma prod_of_Zp_cauchy_is_Zp_cauchy:
assumes "is_Zp_cauchy s"
assumes "is_Zp_cauchy t"
shows "is_Zp_cauchy (s ⊗⇘Zp⇗ω⇖⇙ t)"
proof(rule is_Zp_cauchyI)
show "(s ⊗⇘Zp⇗ω⇖⇙ t) ∈ closed_seqs Zp"
using assms(1) assms(2) is_Zp_cauchy_def seq_mult_closed by auto
show "⋀n. ∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ (s ⊗⇘Zp⇗ω⇖⇙ t) n0 n = (s ⊗⇘Zp⇗ω⇖⇙ t) n1 n"
proof-
fix n
show "∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ (s ⊗⇘Zp⇗ω⇖⇙ t) n0 n = (s ⊗⇘Zp⇗ω⇖⇙ t) n1 n"
proof-
obtain N1 where N1_def: "∀n0 n1. N1 < n0 ∧ N1 < n1 ⟶ s n0 n = s n1 n"
using assms(1) is_Zp_cauchy_imp_res_eventually_const_0 padic_integers_axioms by blast
obtain N2 where N2_def: "∀n0 n1. N2 < n0 ∧ N2 < n1 ⟶ t n0 n = t n1 n"
using assms(2) is_Zp_cauchy_imp_res_eventually_const_0 padic_integers_axioms by blast
obtain M where M_def: "M = max N1 N2"
by simp
have "∀n0 n1. M < n0 ∧ M < n1 ⟶ (s ⊗⇘Zp⇗ω⇖⇙ t) n0 n = (s ⊗⇘Zp⇗ω⇖⇙ t) n1 n"
proof
fix n0
show "∀n1. M < n0 ∧ M < n1 ⟶ (s ⊗⇘Zp⇗ω⇖⇙ t) n0 n = (s ⊗⇘Zp⇗ω⇖⇙ t) n1 n"
proof
fix n1
show " M < n0 ∧ M < n1 ⟶ (s ⊗⇘Zp⇗ω⇖⇙ t) n0 n = (s ⊗⇘Zp⇗ω⇖⇙ t) n1 n"
proof
assume A: "M < n0 ∧ M < n1 "
have Fs: " s n0 n = s n1 n" using A M_def N1_def by auto
have Ft: " t n0 n = t n1 n" using A M_def N2_def by auto
then show "(s ⊗⇘Zp⇗ω⇖⇙ t) n0 n = (s ⊗⇘Zp⇗ω⇖⇙ t) n1 n"
using seq_mult_simp[of s t] is_Zp_cauchy_imp_closed assms
by (simp add: Fs residue_of_prod)
qed
qed
qed
then show ?thesis
by blast
qed
qed
qed
text‹Constant sequences are cauchy:›
lemma constant_is_Zp_cauchy:
assumes "is_constant_seq Zp s"
shows "is_Zp_cauchy s"
proof(rule is_Zp_cauchyI)
show "s ∈ closed_seqs Zp"
proof(rule closed_seqs_memI)
fix k
show "s k ∈ carrier Zp"
using assms is_constant_seq_imp_closed
by (simp add: is_constant_seq_imp_closed closed_seqs_memE)
qed
obtain x where "⋀ k. s k = x"
using assms
by (meson is_constant_seqE)
then show "⋀n. ∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ s n0 n = s n1 n"
by simp
qed
text‹Scalar multiplies of cauchy sequences are cauchy:›
lemma smult_is_Zp_cauchy:
assumes "is_Zp_cauchy s"
assumes "a ∈ carrier Zp"
shows "is_Zp_cauchy (a ⊙⇘Zp⇗ω⇖⇙ s)"
apply(rule is_Zp_cauchyI)
apply (meson U_function_ring.ring_seq_smult_closed U_function_ring_axioms assms(1) assms(2) is_Zp_cauchy_def)
using assms ring_seq_smult_eval[of s a] is_Zp_cauchy_imp_closed[of s]
by (metis res_lim_Zp_cauchy residue_of_prod)
lemma Zp_cauchy_imp_approaches_res_lim:
assumes "is_Zp_cauchy s"
assumes "a = res_lim s"
obtains N where "⋀n. n> N ⟹ val_Zp (a ⊖ (s n)) > eint k"
proof-
have " (∀n::int. ∃k. ∀m>k. n < val_Zp_dist (s m) a)"
using Zp_converges_to_def[of s a] assms is_Zp_cauchy_imp_has_limit[of s a] val_Zp_dist_def
by simp
then have "∃N. ∀m>N. k < val_Zp_dist (s m) a"
by blast
then obtain N where N_def: "∀m>N. k < val_Zp_dist (s m) a"
by blast
have "⋀n. n> N ⟹ val_Zp (a ⊖ (s n)) > k"
proof-
fix m
assume "m > N"
then have 0: "k < val_Zp_dist (s m) a"
using N_def
by (simp add: val_Zp_def)
show "k < val_Zp (a ⊖ s m)"
using "0" assms(1) assms(2) is_Zp_cauchy_def closed_seqs_memE[of _ Zp] val_Zp_dist_def val_Zp_dist_sym res_lim_in_Zp by auto
qed
then show ?thesis
using that
by blast
qed
section‹Continuous Functions›
text‹
For convenience, we will use a slightly unorthodox definition of continuity here.
Since $\mathbb{Z}_p$ is complete, a function is continuous if and only if its compositions
with cauchy sequences are cauchy sequences. Thus we can define a continuous function on
$\mathbb{Z}_p$ as a function which carries cauchy sequences to cauchy sequences under
composition. Note that this does not generalize to a definition of continuity for functions
defined on incomplete subsets of $\mathbb{Z}_p$. For example, the function $1/x$ defined on
$\mathbb{Z}_p - \{0\}$ clearly does not have this property but is continuous. However, towards
a proof of Hensel's Lemma we will only need to consider polynomial functions and so this
definition suffices for our purposes.
›
subsection‹Defining Continuous Functions and Basic Examples›
abbreviation Zp_constant_function ("𝔠⇘Zp⇙") where
"𝔠⇘Zp⇙ a ≡ constant_function (carrier Zp) a"
definition is_Zp_continuous ::"padic_int_fun ⇒ bool" where
"is_Zp_continuous f = (f ∈ carrier (Fun Zp) ∧(∀ s. is_Zp_cauchy s ⟶ is_Zp_cauchy(f ∘ s)))"
lemma Zp_continuous_is_Zp_closed:
assumes "is_Zp_continuous f"
shows "f ∈ carrier (Fun Zp)"
using assms is_Zp_continuous_def by blast
lemma is_Zp_continuousI:
assumes "f ∈ carrier (Fun Zp)"
assumes "⋀s. is_Zp_cauchy s ⟹ is_Zp_cauchy (f ∘ s)"
shows "is_Zp_continuous f"
proof-
have "(∀ s. is_Zp_cauchy s ⟶ is_Zp_cauchy(f ∘ s))"
proof
fix s
show "is_Zp_cauchy s ⟶ is_Zp_cauchy (f ∘ s) "
by (simp add: assms(2))
qed
then show ?thesis
using assms(1) is_Zp_continuous_def by blast
qed
lemma Zp_continuous_is_closed:
assumes "is_Zp_continuous f"
shows "f ∈ carrier (Fun Zp)"
using assms unfolding is_Zp_continuous_def by blast
lemma constant_is_Zp_continuous:
assumes "a ∈ carrier Zp"
shows "is_Zp_continuous (const a)"
proof(rule is_Zp_continuousI)
show "𝔠⇘Zp⇙ a ∈ carrier (function_ring (carrier Zp) Zp)"
by (simp add: assms constant_function_closed)
show "⋀s. is_Zp_cauchy s ⟹ is_Zp_cauchy (𝔠⇘Zp⇙ a ∘ s) "
proof-
fix s
assume A: "is_Zp_cauchy s"
have "is_constant_seq Zp (𝔠⇘Zp⇙ a ∘ s)"
using constant_function_comp_is_constant_seq[of a s] A assms
is_Zp_cauchy_imp_closed by blast
then show "is_Zp_cauchy (𝔠⇘Zp⇙ a ∘ s)"
using A assms constant_is_Zp_cauchy
by blast
qed
qed
lemma sum_of_cont_is_cont:
assumes "is_Zp_continuous f"
assumes "is_Zp_continuous g"
shows "is_Zp_continuous (f ⊕⇘Fun Zp⇙ g)"
apply(rule is_Zp_continuousI)
using assms Zp_continuous_is_closed assms function_sum_comp_is_seq_sum[of _ f g]
apply (simp add: fun_add_closed)
using assms(1) assms(2) function_sum_comp_is_seq_sum is_Zp_cauchy_def is_Zp_continuous_def sum_of_Zp_cauchy_is_Zp_cauchy by auto
lemma prod_of_cont_is_cont:
assumes "is_Zp_continuous f"
assumes "is_Zp_continuous g"
shows "is_Zp_continuous (f ⊗⇘Fun Zp⇙ g)"
apply(rule is_Zp_continuousI)
using assms Zp_continuous_is_closed assms
apply (simp add: fun_mult_closed)
using function_mult_comp_is_seq_mult[of _ f g] assms(1) assms(2) is_Zp_cauchy_imp_closed
is_Zp_continuous_def prod_of_Zp_cauchy_is_Zp_cauchy by auto
lemma smult_is_continuous:
assumes "is_Zp_continuous f"
assumes "a ∈ carrier Zp"
shows "is_Zp_continuous (a ⊙⇘Fun Zp⇙ f)"
apply(rule is_Zp_continuousI)
using assms apply (simp add: assms function_smult_closed is_Zp_continuous_def)
using ring_seq_smult_comp_assoc assms
by (simp add: is_Zp_cauchy_imp_closed is_Zp_continuous_def smult_is_Zp_cauchy)
lemma id_Zp_is_Zp_continuous:
"is_Zp_continuous ring_id"
apply(rule is_Zp_continuousI)
by (auto simp add: is_Zp_cauchy_imp_closed ring_id_seq_comp)
lemma nat_pow_is_Zp_continuous:
assumes "is_Zp_continuous f"
shows "is_Zp_continuous (f[^]⇘Fun Zp⇙(n::nat))"
apply(induction n)
using constant_is_Zp_continuous function_one_is_constant apply force
by (simp add: assms prod_of_cont_is_cont)
lemma ring_id_pow_closed:
"(ring_id)[^]⇘Fun Zp⇙ (n::nat) ∈ carrier (Fun Zp)"
by (simp add: function_ring_is_monoid monoid.nat_pow_closed)
lemma monomial_equation:
assumes "c ∈ carrier Zp"
shows "monomial c n = c ⊙⇘Fun Zp⇙ (ring_id)[^]⇘Fun Zp⇙n"
apply(rule function_ring_car_eqI)
apply (simp add: assms monomial_functions)
using assms function_smult_closed[of c "ring_id [^]⇘Fun Zp⇙ n"] ring_id_pow_closed apply blast
unfolding monomial_function_def
using assms function_smult_eval[of c "(ring_id)[^]⇘Fun Zp⇙ (n::nat)"]
function_nat_pow_eval[of ring_id _ n]
by (simp add: ring_id_eval ring_id_pow_closed)
lemma monomial_is_Zp_continuous:
assumes "c ∈ carrier Zp"
shows "is_Zp_continuous (monomial c n)"
using monomial_equation[of c n] nat_pow_is_Zp_continuous
by (simp add: assms id_Zp_is_Zp_continuous smult_is_continuous)
subsection‹Composition by a Continuous Function Commutes with Taking Limits of Sequences›
text ‹
Due to our choice of definition for continuity, a little bit of care is required to show that
taking the limit of a cauchy sequence commutes with composition by a continuous function.
For a sequence $(s_n)_{n \in \mathbb{N}}$ converging to a point $t$, we can consider the
alternating sequence $(s_0, t, s_1, t, s_2, t, \dots)$ which is also cauchy. Clearly
composition with $f$ yields $(f(s_0), f(t), f(s_1), f(t), f(s_2), f(t), \dots)$ from which
we can see that the limit must be $f(t)$.
›
definition alt_seq where
"alt_seq s = (λk. (if (even k) then (s k) else (res_lim s)))"
lemma alt_seq_Zp_cauchy:
assumes "is_Zp_cauchy s"
shows "is_Zp_cauchy (alt_seq s)"
proof(rule is_Zp_cauchyI)
show "(alt_seq s) ∈ closed_seqs Zp"
unfolding alt_seq_def using assms is_Zp_cauchy_imp_closed
by (simp add: closed_seqs_memE closed_seqs_memI res_lim_in_Zp)
fix n
show "∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ alt_seq s n0 n = alt_seq s n1 n "
proof-
obtain N where N_def: " ∀n0 n1. N < n0 ∧ N < n1 ⟶ s n0 n = s n1 n "
using assms is_Zp_cauchy_imp_res_eventually_const_0
padic_integers_axioms
by blast
have "∀n0 n1. N < n0 ∧ N < n1 ⟶ alt_seq s n0 n = alt_seq s n1 n "
apply auto
proof-
fix n0 n1
assume A: "N < n0" "N < n1"
show "alt_seq s n0 n = alt_seq s n1 n"
using N_def
unfolding alt_seq_def
by (smt A(1) A(2) assms lessI max_less_iff_conj
res_lim_Zp_cauchy padic_integers_axioms)
qed
then show ?thesis
by blast
qed
qed
lemma alt_seq_limit:
assumes "is_Zp_cauchy s"
shows "res_lim(alt_seq s) = res_lim s"
proof-
have "⋀k. res_lim(alt_seq s) k = res_lim s k"
proof-
fix k
obtain N where N_def: "∀ m. m> N ⟶ s m k = res_lim s k"
using assms res_lim_Zp_cauchy
by blast
obtain N' where N'_def: "∀ m. m> N' ⟶ (alt_seq s) m k = res_lim (alt_seq s) k"
using assms res_lim_Zp_cauchy
alt_seq_Zp_cauchy
by blast
have "⋀m. m > (max N N') ⟹ s m k = res_lim (alt_seq s) k"
proof-
fix m
assume A0: "m > (max N N')"
have A1: "s m k = res_lim s k"
using A0 N_def
by simp
have A2: "(alt_seq s) m k = res_lim (alt_seq s) k"
using A0 N'_def
by simp
have A3: "(alt_seq s) m k = res_lim s k"
using alt_seq_def A1 A2
by presburger
show "s m k = res_lim (alt_seq s) k"
using A1 A2 A3
by auto
qed
then have P:"⋀m. m > (max N N') ⟹ (res_lim s k) = res_lim (alt_seq s) k"
using N_def
by auto
show "res_lim(alt_seq s) k = res_lim s k"
using P[of "Suc (max N N')"]
by auto
qed
then show ?thesis
by (simp add: ext)
qed
lemma res_lim_pushforward:
assumes "is_Zp_continuous f"
assumes "is_Zp_cauchy s"
assumes "t = alt_seq s"
shows "res_lim (f ∘ t) = f (res_lim t)"
proof-
have 0: "Zp_converges_to (f ∘ t) (res_lim (f ∘ t))"
using assms alt_seq_Zp_cauchy is_Zp_cauchy_imp_has_limit
is_Zp_continuous_def
by blast
have "⋀k. res_lim (f ∘ t) k = f (res_lim t) k"
proof-
fix k
show "res_lim (f ∘ t) k = f (res_lim t) k"
proof-
obtain N where N_def: "⋀m. m> N ⟹ (f ∘ t) m k = (res_lim (f ∘ t)) k"
using 0
by (meson convergent_imp_Zp_cauchy Zp_converges_to_def res_lim_Zp_cauchy)
obtain M where M_def: "M = 2*(Suc N) + 1"
by simp
have 0: "t M = res_lim s"
using assms
unfolding alt_seq_def
by (simp add: M_def)
have 1: "(f ∘ t) M k = (res_lim (f ∘ t)) k"
using N_def M_def
by auto
have 2: "(f ∘ t) M k = f (t M) k"
by simp
have 3: "(f ∘ t) M k = f (res_lim s) k"
using 0 2 by simp
have 4: "(f ∘ t) M k = f (res_lim t) k"
using 3 assms alt_seq_limit[of s]
by auto
show ?thesis
using 4 1 by auto
qed
qed
then show ?thesis by(simp add: ext)
qed
lemma res_lim_pushforward':
assumes "is_Zp_continuous f"
assumes "is_Zp_cauchy s"
assumes "t = alt_seq s"
shows "res_lim (f ∘ s) = res_lim (f ∘ t)"
proof-
obtain a where a_def: "a = res_lim (f ∘ s)"
by simp
obtain b where b_def: "b = res_lim (f ∘ t)"
by simp
have "⋀k. a k = b k"
proof-
fix k
obtain Na where Na_def: "⋀m. m > Na ⟹ (f ∘ s) m k = a k"
using a_def assms is_Zp_continuous_def
padic_integers_axioms res_lim_Zp_cauchy
by blast
obtain Nb where Nb_def: "⋀m. m > Nb ⟹ (f ∘ t) m k = b k"
using b_def assms is_Zp_continuous_def
padic_integers_axioms res_lim_Zp_cauchy
alt_seq_Zp_cauchy
by blast
obtain M where M_def: "M = 2*(max Na Nb) + 1"
by simp
have M0: "odd M"
by (simp add: M_def)
have M1: "M > Na"
using M_def
by auto
have M2: "M > Nb"
using M_def
by auto
have M3: "t M = res_lim s"
using assms alt_seq_def M0
by auto
have M4: "((f ∘ t) M) = f (res_lim s)"
using M3
by auto
have M5: "((f ∘ t) M) k = b k"
using M2 Nb_def by auto
have M6: "f (res_lim s) = f (res_lim t)"
using assms alt_seq_limit[of s]
by auto
have M7: "f (res_lim t) k = b k"
using M4 M5 M6 by auto
have M8: "(f ∘ s) M k = (f ∘ s) (Suc M) k"
using M1 Na_def by auto
have M9: "(f ∘ s) (Suc M) = (f ∘ t) (Suc M)"
using assms unfolding alt_seq_def
using M_def
by auto
have M10: "(f ∘ t) M k = (f ∘ t) (Suc M) k"
using M2 Nb_def by auto
have M11: "(f ∘ t) M k = (f ∘ s) M k"
using M10 M8 M9 by auto
show "a k = b k"
using M1 M11 M5 Na_def by auto
qed
then show ?thesis using a_def b_def ext[of a b] by auto
qed
lemma continuous_limit:
assumes "is_Zp_continuous f"
assumes "is_Zp_cauchy s"
shows "Zp_converges_to (f ∘ s) (f (res_lim s))"
proof-
obtain t where t_def: "t = alt_seq s"
by simp
have 0: "Zp_converges_to (f ∘ s) (res_lim (f ∘ s))"
using assms(1) assms(2) is_Zp_continuous_def
is_Zp_cauchy_imp_has_limit padic_integers_axioms by blast
have 1: "Zp_converges_to (f ∘ s) (res_lim (f ∘ t))"
using "0" assms(1) assms(2) res_lim_pushforward' t_def by auto
have 2: "Zp_converges_to (f ∘ s) (f (res_lim t))"
using "1" assms(1) assms(2) res_lim_pushforward padic_integers_axioms t_def by auto
then show "Zp_converges_to (f ∘ s) (f (res_lim s))"
by (simp add: alt_seq_limit assms(2) t_def)
qed
end
end
Theory Padic_Int_Polynomials
theory Padic_Int_Polynomials
imports Padic_Int_Topology Cring_Poly
begin
context padic_integers
begin
text‹
This theory states and proves basic lemmas connecting the topology on $\mathbb{Z}_p$ with the
functions induced by polynomial evaluation over $\mathbb{Z}_p$. This will imply that polynomial
evaluation applied to a Cauchy Sequence will always produce a cauchy sequence, which is a key
fact in the proof of Hensel's Lemma.
›
type_synonym padic_int_poly = "nat ⇒ padic_int"
lemma monom_term_car:
assumes "c ∈ carrier Zp"
assumes "x ∈ carrier Zp"
shows "c ⊗ x[^](n::nat) ∈ carrier Zp"
using assms R.nat_pow_closed
by (simp add: monoid.nat_pow_closed cring.cring_simprules(5) cring_def ring_def)
text‹Univariate polynomial ring over Zp›
abbreviation(input) Zp_x where
"Zp_x ≡ UP Zp"
lemma Zp_x_is_UP_cring:
"UP_cring Zp"
using UP_cring.intro domain_axioms domain_def by auto
lemma Zp_x_is_UP_domain:
"UP_domain Zp"
by (simp add: UP_domain_def domain_axioms)
lemma Zp_x_domain:
"domain Zp_x "
by (simp add: UP_domain.UP_domain Zp_x_is_UP_domain)
lemma pow_closed:
assumes "a ∈ carrier Zp"
shows "a[^](n::nat) ∈ carrier Zp"
by (meson domain_axioms domain_def cring_def assms monoid.nat_pow_closed ring_def)
lemma(in ring) pow_zero:
assumes "(n::nat)>0"
shows "𝟬[^] n = 𝟬"
by (simp add: assms nat_pow_zero)
lemma sum_closed:
assumes "f ∈ carrier Zp"
assumes "g ∈ carrier Zp"
shows "f ⊕ g ∈ carrier Zp"
by (simp add: assms(1) assms(2) cring.cring_simprules(1))
lemma mult_zero:
assumes "f ∈ carrier Zp"
shows "f ⊗ 𝟬 = 𝟬"
"𝟬 ⊗ f = 𝟬"
apply (simp add: assms cring.cring_simprules(27))
by (simp add: assms cring.cring_simprules(26))
lemma monom_poly_is_Zp_continuous:
assumes "c ∈ carrier Zp"
assumes "f = monom Zp_x c n"
shows "is_Zp_continuous (to_fun f)"
using monomial_is_Zp_continuous assms monom_to_monomial by auto
lemma degree_0_is_Zp_continuous:
assumes "f ∈ carrier Zp_x"
assumes "degree f = 0"
shows "is_Zp_continuous (to_fun f)"
using const_to_constant[of "lcf f"] assms constant_is_Zp_continuous ltrm_deg_0
by (simp add: cfs_closed)
lemma UP_sum_is_Zp_continuous:
assumes "a ∈ carrier Zp_x"
assumes "b ∈ carrier Zp_x"
assumes "is_Zp_continuous (to_fun a)"
assumes "is_Zp_continuous (to_fun b)"
shows "is_Zp_continuous (to_fun (a ⊕⇘Zp_x⇙ b))"
using sum_of_cont_is_cont assms
by (simp add: to_fun_Fun_add)
lemma polynomial_is_Zp_continuous:
assumes "f ∈ carrier Zp_x"
shows "is_Zp_continuous (to_fun f)"
apply(rule poly_induct3)
apply (simp add: assms)
using UP_sum_is_Zp_continuous apply blast
using monom_poly_is_Zp_continuous by blast
end
text‹Notation for polynomial function application›
context padic_integers
begin
notation to_fun (infixl‹∙› 70)
text‹Evaluating polynomials in the residue rings›
lemma res_to_fun_monic_monom:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "a k = b k"
shows "(monom Zp_x 𝟭 n ∙ a) k = (monom Zp_x 𝟭 n ∙ b) k"
proof(induction n)
case 0
then show ?case
using UP_cring.to_fun_X_pow Zp_x_is_UP_domain assms(1) assms(2) nat_pow_0 to_fun_one monom_one
by presburger
next
case (Suc n)
fix n::nat
assume IH: "to_fun (monom Zp_x 𝟭 n) a k = to_fun (monom Zp_x 𝟭 n) b k"
show "to_fun (monom Zp_x 𝟭 (Suc n)) a k = to_fun (monom Zp_x 𝟭 (Suc n)) b k"
proof-
have LHS0: "(monom Zp_x 𝟭 (Suc n) ∙ a) k = ((monom Zp_x 𝟭 n ∙ a) ⊗ (X ∙ a)) k"
by (simp add: UP_cring.to_fun_monic_monom Zp_x_is_UP_cring assms(1))
then show ?thesis
using assms IH Zp_x_is_UP_domain
Zp_continuous_is_Zp_closed
by (metis (mono_tags, lifting) R.one_closed X_poly_def monom_closed monom_one_Suc
residue_of_prod to_fun_X to_fun_mult)
qed
qed
lemma res_to_fun_monom:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "c ∈ carrier Zp"
assumes "a k = b k"
shows "(monom Zp_x c n ∙ a) k = (monom Zp_x c n ∙ b) k"
using res_to_fun_monic_monom assms
by (smt to_fun_monic_monom to_fun_monom residue_of_prod)
lemma to_fun_res_ltrm:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "f ∈ carrier Zp_x"
assumes "a k = b k"
shows "((ltrm f)∙a) k = ((ltrm f)∙b) k"
by (simp add: lcf_closed assms(1) assms(2) assms(3) assms(4) res_to_fun_monom)
text‹Polynomial application commutes with taking residues›
lemma to_fun_res:
assumes "f ∈ carrier Zp_x"
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "a k = b k"
shows "(f∙a) k = (f∙b) k"
apply(rule poly_induct3[of f])
apply (simp add: assms(1))
using assms(2) assms(3) to_fun_plus residue_of_sum apply presburger
using assms(2) assms(3) assms(4) res_to_fun_monom by blast
text‹If a and b have equal kth residues, then so do f'(a) and f'(b)›
lemma deriv_res:
assumes "f ∈ carrier Zp_x"
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "a k = b k"
shows "(deriv f a) k = (deriv f b) k"
using assms to_fun_res[of "pderiv f" a b k]
by (simp add: pderiv_closed pderiv_eval_deriv)
text‹Propositions about evaluation:›
lemma to_fun_monom_plus:
assumes "a ∈ carrier Zp"
assumes "g ∈ carrier Zp_x"
assumes "c ∈ carrier Zp"
shows "(monom Zp_x a n ⊕⇘Zp_x⇙ g)∙c = a ⊗ c[^]n ⊕ (g ∙ c)"
by (simp add: assms(1) assms(2) assms(3) to_fun_monom to_fun_plus)
lemma to_fun_monom_minus:
assumes "a ∈ carrier Zp"
assumes "g ∈ carrier Zp_x"
assumes "c ∈ carrier Zp"
shows "(monom Zp_x a n ⊖⇘Zp_x⇙ g)∙c = a ⊗ c[^]n ⊖ (g ∙ c)"
by (simp add: UP_cring.to_fun_diff Zp_x_is_UP_cring assms(1) assms(2) assms(3) to_fun_monom)
end
end
Theory Hensels_Lemma
theory Hensels_Lemma
imports Padic_Int_Polynomials
begin
text‹
The following proof of Hensel's Lemma is directly adapted from Keith Conrad's proof which is
given in an online note \cite{keithconrad}. The same note was used as the basis for a
formalization of Hensel's Lemma by Robert Lewis in the Lean proof assistant
\cite{10.1145/3293880.3294089}. ›
section‹Auxiliary Lemmas for Hensel's Lemma›
lemma(in ring) minus_sum:
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
shows "⊖ (a ⊕ b) = ⊖ a ⊕ ⊖ b"
by (simp add: assms(1) assms(2) local.minus_add)
context padic_integers
begin
lemma poly_diff_val:
assumes "f ∈ carrier Zp_x"
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
shows "val_Zp (f∙a ⊖ f∙b) ≥ val_Zp (a ⊖ b)"
proof-
obtain c where c_def: "c ∈ carrier Zp ∧ (f∙a ⊖ f∙b) = (a ⊖ b) ⊗ c"
using assms
by (meson to_fun_diff_factor)
have 1: "val_Zp c ≥ 0"
using c_def val_pos by blast
have 2: "val_Zp (f∙a ⊖ f∙b) = val_Zp (a ⊖ b) + (val_Zp c)"
using c_def val_Zp_mult
by (simp add: assms(2) assms(3))
then show ?thesis
using "1" by auto
qed
text‹Restricted p-adic division›
definition divide where
"divide x y = (if x = 𝟬 then 𝟬 else
(𝗉[^](nat (ord_Zp x - ord_Zp y)) ⊗ ac_Zp x ⊗ (inv ac_Zp y)))"
lemma divide_closed:
assumes "x ∈ carrier Zp"
assumes "y ∈ carrier Zp"
assumes "y ≠ 𝟬"
shows "divide x y ∈ carrier Zp"
unfolding divide_def
apply(cases "x = 𝟬")
apply auto[1]
using assms ac_Zp_is_Unit
by (simp add: ac_Zp_in_Zp)
lemma divide_formula:
assumes "x ∈ carrier Zp"
assumes "y ∈ carrier Zp"
assumes "y ≠ 𝟬"
assumes "val_Zp x ≥ val_Zp y"
shows "y ⊗ divide x y = x"
apply(cases "x = 𝟬")
apply (simp add: divide_def mult_zero_l)
proof- assume A: "x ≠ 𝟬"
have 0: "y ⊗ divide x y = 𝗉[^] nat (ord_Zp y) ⊗ ac_Zp y ⊗ (𝗉[^](nat (ord_Zp x - ord_Zp y)) ⊗ ac_Zp x ⊗ (inv ac_Zp y))"
using assms ac_Zp_factors_x[of x] ac_Zp_factors_x[of y] A divide_def
by auto
hence 1: "y ⊗ divide x y = 𝗉[^] nat (ord_Zp y) ⊗ (𝗉[^](nat (ord_Zp x - ord_Zp y)) ⊗ ac_Zp x ⊗ ac_Zp y ⊗ (inv ac_Zp y))"
using mult_assoc mult_comm by auto
have 2: "(nat (ord_Zp y) + nat (ord_Zp x - ord_Zp y)) = nat (ord_Zp x)"
using assms ord_pos[of x] ord_pos[of y] A val_ord_Zp by auto
have "y ⊗ divide x y = 𝗉[^] nat (ord_Zp y) ⊗ 𝗉[^](nat (ord_Zp x - ord_Zp y)) ⊗ ac_Zp x"
using 1 A assms
by (simp add: ac_Zp_in_Zp ac_Zp_is_Unit mult_assoc)
thus "y ⊗ divide x y = x"
using "2" A ac_Zp_factors_x(1) assms(1) p_natpow_prod by auto
qed
lemma divide_nonzero:
assumes "x ∈ nonzero Zp"
assumes "y ∈ nonzero Zp"
assumes "val_Zp x ≥ val_Zp y"
shows "divide x y ∈ nonzero Zp"
by (metis assms(1) assms(2) assms(3) divide_closed divide_formula mult_zero_l nonzero_closed nonzero_memE(2) nonzero_memI)
lemma val_of_divide:
assumes "x ∈ carrier Zp"
assumes "y ∈ nonzero Zp"
assumes "val_Zp x ≥ val_Zp y"
shows "val_Zp (divide x y) = val_Zp x - val_Zp y"
proof-
have 0: "y ⊗ divide x y = x"
by (simp add: assms(1) assms(2) assms(3) divide_formula nonzero_closed nonzero_memE(2))
hence "val_Zp y + val_Zp (divide x y) = val_Zp x"
using assms(1) assms(2) divide_closed nonzero_closed not_nonzero_memI val_Zp_mult by fastforce
thus ?thesis
by (smt Zp_def add.commute add.left_neutral add.right_neutral add_diff_assoc_eint assms(1)
assms(2) divide_nonzero eSuc_minus_eSuc iadd_Suc idiff_0_right mult_zero(1) mult_zero_l
nonzero_closed ord_pos order_refl padic_integers.Zp_int_inc_closed padic_integers.mult_comm
padic_integers.ord_of_nonzero(2) padic_integers_axioms val_Zp_eq_frac_0 val_Zp_mult val_Zp_p)
qed
lemma val_of_divide':
assumes "x ∈ carrier Zp"
assumes "y ∈ carrier Zp"
assumes "y ≠ 𝟬"
assumes "val_Zp x ≥ val_Zp y"
shows "val_Zp (divide x y) = val_Zp x - val_Zp y"
using Zp_def assms(1) assms(2) assms(3) assms(4) padic_integers.not_nonzero_Zp
padic_integers.val_of_divide padic_integers_axioms by blast
end
lemma(in UP_cring) taylor_deg_1_eval''':
assumes "f ∈ carrier P"
assumes "a ∈ carrier R"
assumes "b ∈ carrier R"
assumes "c = to_fun (shift (2::nat) (T⇘a⇙ f)) (⊖b)"
assumes "b ⊗ (deriv f a) = (to_fun f a)"
shows "to_fun f (a ⊖ b) = (c ⊗ b[^](2::nat))"
proof-
have 0: "to_fun f (a ⊖ b) = (to_fun f a) ⊖ (deriv f a ⊗ b) ⊕ (c ⊗ b[^](2::nat))"
using assms taylor_deg_1_eval''
by blast
have 1: "(to_fun f a) ⊖ (deriv f a ⊗ b) = 𝟬"
using assms
proof -
have "∀f a. f ∉ carrier P ∨ a ∉ carrier R ∨ to_fun f a ∈ carrier R"
using to_fun_closed by presburger
then show ?thesis
using R.m_comm R.r_right_minus_eq assms(1) assms(2) assms(3) assms(5)
by (simp add: deriv_closed)
qed
have 2: "to_fun f (a ⊖ b) = 𝟬 ⊕ (c ⊗ b[^](2::nat))"
using 0 1
by simp
then show ?thesis using assms
by (simp add: taylor_closed to_fun_closed shift_closed)
qed
lemma(in padic_integers) res_diff_zero_fact:
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "(a ⊖ b) k = 0"
shows "a k = b k" "a k ⊖⇘Zp_res_ring k⇙ b k = 0"
apply(cases "k = 0")
apply (metis assms(1) assms(2) p_res_ring_0 p_res_ring_0' p_res_ring_car p_residue_padic_int p_residue_range' zero_le)
apply (metis R.add.inv_closed R.add.m_lcomm R.minus_eq R.r_neg R.r_zero Zp_residue_add_zero(2) assms(1) assms(2) assms(3))
using assms(2) assms(3) residue_of_diff by auto
lemma(in padic_integers) res_diff_zero_fact':
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "a k = b k"
shows "a k ⊖⇘Zp_res_ring k⇙ b k = 0"
by (simp add: assms(3) residue_minus)
lemma(in padic_integers) res_diff_zero_fact'':
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "a k = b k"
shows "(a ⊖ b) k = 0"
by (simp add: assms(2) assms(3) res_diff_zero_fact' residue_of_diff)
lemma(in padic_integers) is_Zp_cauchyI':
assumes "s ∈ closed_seqs Zp"
assumes "∀n::nat. ∃ k::int.∀m. m ≥ k ⟶ val_Zp (s (Suc m) ⊖ s m) ≥ n"
shows "is_Zp_cauchy s"
proof(rule is_Zp_cauchyI)
show A0: "s ∈ closed_seqs Zp"
by (simp add: assms(1))
show "⋀n. ∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ s n0 n = s n1 n"
proof-
fix n
show "∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ s n0 n = s n1 n"
proof(induction n)
case 0
then show ?case
proof-
have "∀n0 n1. 0 < n0 ∧ 0 < n1 ⟶ s n0 0 = s n1 0"
apply auto
proof-
fix n0 n1::nat
assume A: "n0 > 0" "n1 > 0"
have 0: "s n0 ∈ carrier Zp"
using A0
by (simp add: closed_seqs_memE)
have 1: "s n1 ∈ carrier Zp"
using A0
by (simp add: closed_seqs_memE)
show " s n0 (0::nat) = s n1 (0::nat)"
using A0 Zp_def 0 1 residues_closed
by (metis p_res_ring_0')
qed
then show ?thesis
by blast
qed
next
case (Suc n)
fix n
assume IH: "∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ s n0 n = s n1 n"
show " ∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ s n0 (Suc n) = s n1 (Suc n)"
proof-
obtain N where N_def: "∀n0 n1. N < n0 ∧ N < n1 ⟶ s n0 n = s n1 n"
using IH
by blast
obtain k where k_def: "∀m. (Suc m) ≥ k ⟶ val_Zp (s (Suc (Suc m)) ⊖ s (Suc m)) ≥ Suc (Suc n)"
using assms Suc_n_not_le_n
by (meson nat_le_iff)
have "∀n0 n1. Suc (max N (max n k)) < n0 ∧ Suc (max N (max n k))< n1 ⟶ s n0 (Suc n) = s n1 (Suc n)"
apply auto
proof-
fix n0 n1
assume A: "Suc (max N (max n k)) < n0" " Suc (max N (max n k)) < n1"
show "s n0 (Suc n) = s n1 (Suc n) "
proof-
obtain K where K_def: "K = Suc (max N (max n k))"
by simp
have P0: "⋀m. s ((Suc m)+ K) (Suc n) = s (Suc K) (Suc n)"
apply auto
proof-
fix m
show "s (Suc (m + K)) (Suc n) = s (Suc K) (Suc n)"
apply(induction m)
apply auto
proof-
fix m
assume A0: " s (Suc (m + K)) (Suc n) = s (Suc K) (Suc n)"
show " s (Suc (Suc (m + K))) (Suc n) = s (Suc K) (Suc n)"
proof-
have I: "k < m + K"
using K_def
by linarith
have "val_Zp (s (Suc (Suc (m + K))) ⊖ s (Suc (m + K))) ≥ Suc (Suc n)"
proof-
have "(Suc (m + K)) > k"
by (simp add: I less_Suc_eq)
then show ?thesis
using k_def less_imp_le_nat
by blast
qed
hence D: "val_Zp (s (Suc (Suc (m + K))) ⊖ s (Suc (m + K))) > (Suc n)"
using Suc_ile_eq by fastforce
have "s (Suc (Suc (m + K))) (Suc n) = s (Suc (m + K)) (Suc n)"
proof-
have "(s (Suc (Suc (m + K))) ⊖ s (Suc (m + K))) (Suc n) = 0"
using D assms(1) res_diff_zero_fact''[of "s (Suc (Suc (m + K)))" "s (Suc (m + K)) " "Suc n"]
val_Zp_dist_res_eq[of "s (Suc (Suc (m + K)))" "s (Suc (m + K)) " "Suc n"] unfolding val_Zp_dist_def
by (simp add: closed_seqs_memE)
hence 0: "(s (Suc (Suc (m + K))) (Suc n) ⊖⇘Zp_res_ring (Suc n)⇙ (s (Suc (m + K))) (Suc n)) = 0"
using res_diff_zero_fact(2)[of "s (Suc (Suc (m + K)))" "s (Suc (m + K))" "Suc n" ]
assms(1)
by (simp add: closed_seqs_memE)
show ?thesis
proof-
have 00: "cring (Zp_res_ring (Suc n))"
using R_cring by blast
have 01: " s (Suc (Suc (m + K))) (Suc n) ∈ carrier (Zp_res_ring (Suc n))"
using assms(1) closed_seqs_memE residues_closed by blast
have 02: "(⊖⇘Zp_res_ring (Suc n)⇙ (s (Suc (m + K)) (Suc n))) ∈ carrier (Zp_res_ring (Suc n)) "
by (meson "00" assms(1) cring.cring_simprules(3) closed_seqs_memE residues_closed)
show ?thesis
unfolding a_minus_def
using 00 01 02
cring.sum_zero_eq_neg[of "Zp_res_ring (Suc n)" "s (Suc (Suc (m + K))) (Suc n)"
"⊖⇘Zp_res_ring (Suc n)⇙s (Suc (m + K)) (Suc n)"]
by (metis 0 a_minus_def assms(1) cring.cring_simprules(21) closed_seqs_memE
p_res_ring_zero residues_closed)
qed
qed
then show ?thesis using A0 assms(1)
by simp
qed
qed
qed
have "∃m0. n0 = (Suc m0) + K"
proof-
have "n0 > K"
by (simp add: A(1) K_def)
then have "n0 = (Suc (n0 - K - 1)) + K"
by auto
then show ?thesis by blast
qed
then obtain m0 where m0_def: "n0 = (Suc m0) + K"
by blast
have "∃m0. n1 = (Suc m0) + K"
proof-
have "n1 > K"
by (simp add: A(2) K_def)
then have "n1 = (Suc (n1 - K - 1)) + K"
by auto
then show ?thesis by blast
qed
then obtain m1 where m1_def: "n1 = (Suc m1) + K"
by blast
have 0: "s n0 (Suc n) = s (Suc K) (Suc n)"
using m0_def P0[of "m0"] by auto
have 1: "s n1 (Suc n) = s (Suc K) (Suc n)"
using m1_def P0[of "m1"] by auto
show ?thesis using 0 1
by auto
qed
qed
then show ?thesis
by blast
qed
qed
qed
qed
section‹The Proof of Hensel's Lemma›
subsection‹Building a Locale for the Proof of Hensel's Lemma›
locale hensel = padic_integers+
fixes f::padic_int_poly
fixes a::padic_int
assumes f_closed[simp]: "f ∈ carrier Zp_x"
assumes a_closed[simp]: "a ∈ carrier Zp"
assumes fa_nonzero[simp]: "f∙a ≠𝟬"
assumes hensel_hypothesis[simp]: "(val_Zp (f∙a) > 2* val_Zp ((pderiv f)∙a))"
sublocale hensel < cring Zp
by (simp add: R.is_cring)
context hensel
begin
abbreviation f' where
"f' ≡ pderiv f"
lemma f'_closed:
"f' ∈ carrier Zp_x"
using f_closed pderiv_closed by blast
lemma f'_vals_closed:
assumes "a ∈ carrier Zp"
shows "f'∙a ∈ carrier Zp"
by (simp add: UP_cring.to_fun_closed Zp_x_is_UP_cring f'_closed)
lemma fa_closed:
"(f∙a) ∈ carrier Zp"
by (simp add: UP_cring.to_fun_closed Zp_x_is_UP_cring)
lemma f'a_closed:
"(f'∙a) ∈ carrier Zp"
proof-
have "f' ∈ carrier Zp_x"
by (simp add: f'_closed)
then show ?thesis
by (simp add: f'_vals_closed)
qed
lemma fa_nonzero':
"(f∙a) ∈ nonzero Zp"
using fa_closed fa_nonzero not_nonzero_Zp by blast
lemma f'a_nonzero[simp]:
"(f'∙a) ≠ 𝟬"
proof(rule ccontr)
assume "¬ (f'∙a) ≠ 𝟬"
then have "(f'∙a) = 𝟬"
by blast
then have "∞ < val_Zp (f∙a)" using hensel_hypothesis
by (simp add: val_Zp_def)
thus False
using eint_ord_simps(6) by blast
qed
lemma f'a_nonzero':
"(f'∙a) ∈ nonzero Zp"
using f'a_closed f'a_nonzero not_nonzero_Zp by blast
lemma f'a_not_infinite[simp]:
"val_Zp (f'∙a) ≠ ∞"
by (metis eint_ord_code(3) hensel_hypothesis linorder_not_less times_eint_simps(4))
lemma f'a_nonneg_val[simp]:
"val_Zp ((f'∙a)) ≥ 0"
using f'a_closed val_pos by blast
lemma hensel_hypothesis_weakened:
"val_Zp (f∙a) > val_Zp (f'∙a)"
proof-
have 0: "0 ≤ val_Zp (f'∙a) ∧ val_Zp (f'∙a) ≠ ∞"
using f'a_closed val_ord_Zp val_pos by force
have 1: "1 < eint 2 "
by (simp add: one_eint_def)
thus ?thesis using 0 eint_mult_mono'[of "val_Zp (f'∙a)" 1 2] hensel_hypothesis
by (metis linorder_not_less mult_one_left order_trans)
qed
subsection‹Constructing the Newton Sequence›
definition newton_step :: "padic_int ⇒ padic_int" where
"newton_step x = x ⊖ (divide (f∙x) (f'∙x))"
lemma newton_step_closed:
"newton_step a ∈ carrier Zp"
using divide_closed unfolding newton_step_def
using f'a_closed f'a_nonzero fa_closed local.a_closed by blast
fun newton_seq :: "padic_int_seq" ("ns") where
"newton_seq 0 = a"|
"newton_seq (Suc n) = newton_step (newton_seq n)"
subsection‹Key Properties of the Newton Sequence›
lemma hensel_factor_id:
"(divide (f∙a) (f'∙a)) ⊗ ((f'∙a)) = (f∙a)"
using hensel_hypothesis hensel_axioms divide_formula f'a_closed
fa_closed hensel_hypothesis_weakened mult_comm
by auto
definition hensel_factor ("t") where
"hensel_factor = val_Zp (f∙a) - 2*(val_Zp (f'∙a))"
lemma t_pos[simp]:
"t > 0"
using hensel_factor_def hensel_hypothesis
by (simp add: eint_minus_le)
lemma t_neq_infty[simp]:
"t ≠ ∞"
by (simp add: hensel_factor_def val_Zp_def)
lemma t_times_pow_pos[simp]:
"(2^(n::nat))*t > 0"
apply(cases "n = 0")
using one_eint_def apply auto[1]
using eint_mult_mono'[of t 1 "2^n"] t_pos
by (smt eint_ord_simps(2) linorder_not_less mult_one_left neq0_conv one_eint_def order_less_le order_trans self_le_power t_neq_infty)
lemma newton_seq_props_induct:
shows "⋀k. k ≤ n ⟹ (ns k) ∈ carrier Zp
∧ val_Zp (f'∙(ns k)) = val_Zp ((f'∙a))
∧ val_Zp (f∙(ns k)) ≥ 2*(val_Zp (f'∙a)) + (2^k)*t"
proof(induction n)
case 0
then have kz: "k = 0"
by simp
have B0: "( ns k) ∈ carrier Zp"
using kz
by simp
have B1: "val_Zp (f' ∙ ns k) = (val_Zp (f'∙a))"
using kz newton_seq.simps(1)
by presburger
have B2: "val_Zp (f ∙ (ns k)) ≥ (2 * (val_Zp (f'∙a))) + 2 ^ k * t"
proof-
have B20: "(2 * (val_Zp (f'∙a))) + 2 ^ k * t = (2 * (val_Zp (f'∙a))) + t"
proof-
have "(2 * (val_Zp (f'∙a))) + 2 ^ k * t = (2 * (val_Zp (f'∙a))) + t"
using kz one_eint_def by auto
then show ?thesis
by blast
qed
then have "(2 * (val_Zp (f'∙a))) + 2 ^ k * t = (2 * (val_Zp (f'∙a))) + val_Zp (f∙a) - 2*(val_Zp (f'∙a))"
unfolding hensel_factor_def
by (simp add: val_Zp_def)
then have "(2 * (val_Zp (f'∙a))) + 2 ^ k * t = val_Zp (f∙a)"
by (metis add_diff_cancel_eint eint_ord_simps(6) hensel_hypothesis)
thus ?thesis by (simp add: kz)
qed
thus ?case
using B0 B1 by blast
next
case (Suc n)
show ?case
proof(cases "k ≤ n")
case True
then show ?thesis using Suc.IH
by blast
next
case False
have F1: "(ns n) ∈ carrier Zp"
using Suc.IH by blast
have F2: "val_Zp (f'∙(ns n)) = val_Zp ((f'∙a))"
using Suc.IH by blast
have F3: "val_Zp (f∙(ns n)) ≥ 2*(val_Zp (f'∙a)) + (2^n)*t"
using Suc.IH by blast
have kval: "k = Suc n"
using False Suc.prems le_Suc_eq by blast
have F6: "val_Zp (f∙(ns n)) ≥ val_Zp (f'∙(ns n))"
proof-
have "2*(val_Zp (f'∙a)) ≥ val_Zp (f'∙a)"
using f'a_closed val_pos eint_mult_mono'[of "val_Zp (f'∙a)" 1 2]
by (metis Groups.add_ac(2) add.right_neutral eSuc_eint eint_0_iff(2) eint_add_left_cancel_le
eint_ord_simps(2) f'a_nonneg_val f'a_not_infinite infinity_ne_i1 linorder_not_less
mult_one_left not_one_less_zero one_add_one one_eint_def order_less_le order_trans zero_one_eint_neq(1))
hence "2*(val_Zp (f'∙a)) + (2^n)*t ≥ val_Zp (f'∙a)"
using t_times_pow_pos[of n]
by (metis (no_types, lifting) add.right_neutral eint_add_left_cancel_le order_less_le order_trans)
then show ?thesis
using F2 F3 by auto
qed
have F5: " divide (f∙(ns n))(f'∙(ns n)) ∈ carrier Zp"
proof-
have 00: "f ∙ ns n ∈ carrier Zp"
by (simp add: F1 to_fun_closed)
have "val_Zp ((f'∙a)) ≠ val_Zp 𝟬"
by (simp add: val_Zp_def)
then have 01: "f' ∙ ns n ∈ nonzero Zp"
using F2 F1 Zp_x_is_UP_cring f'_closed nonzero_def
proof -
have "f' ∙ ns n ∈ carrier Zp"
using F1 Zp_continuous_is_Zp_closed f'_closed polynomial_is_Zp_continuous
by (simp add: to_fun_closed)
then show ?thesis
using F2 ‹val_Zp (f'∙a) ≠ val_Zp 𝟬› not_nonzero_Zp by fastforce
qed
then show ?thesis
using F6
by (metis "00" F2 ‹val_Zp (f'∙a) ≠ val_Zp 𝟬› divide_closed nonzero_closed)
qed
have F4: "(ns k) ⊖ (ns n) = (⊖ divide (f∙(ns n))(f'∙(ns n)))"
using F1 F5 newton_seq.simps(2)[of n] kval
unfolding newton_step_def
by (metis R.l_neg R.minus_closed R.minus_zero R.plus_diff_simp R.r_neg2 R.r_right_minus_eq
a_minus_def local.a_closed minus_a_inv)
have F7: "val_Zp (divide (f∙(ns n))(f'∙(ns n))) = val_Zp (f∙(ns n)) - val_Zp (f'∙(ns n))"
apply(rule val_of_divide)
apply (simp add: F1 to_fun_closed)
using F1 f'_closed to_fun_closed F2 not_nonzero_Zp val_Zp_def apply fastforce
by (simp add: F6)
show ?thesis
proof
show P0:"ns k ∈ carrier Zp"
proof-
have A0: "ns k = ns n ⊖ (divide (f∙ (ns n)) (f'∙(ns n)))"
by (simp add: kval newton_step_def)
have A1: "val_Zp (f'∙(ns n)) = val_Zp (f'∙a)"
using Suc.IH
by blast
have A2: "val_Zp (f∙(ns n)) ≥val_Zp (f'∙a)"
proof-
have A20: "(2 * val_Zp (f'∙a)) + 2 ^ n * (val_Zp (f∙a) - 2 * val_Zp (f'∙a)) ≥val_Zp (f'∙a)"
proof-
have "val_Zp (f∙a) - 2 * val_Zp (f'∙a) > 0"
using hensel_hypothesis eint_minus_le by blast
then have " (2 ^ n) * (val_Zp (f∙a) - 2 * val_Zp (f'∙a))
≥ (val_Zp (f∙a) - 2 * val_Zp (f'∙a))"
using eint_pos_int_times_ge by auto
then have " ((2 * val_Zp (f'∙a)) + 2 ^ n * (val_Zp (f∙a) - 2 * val_Zp (f'∙a)))
≥ (2 * val_Zp (f'∙a)) + (val_Zp (f∙a) - 2 * val_Zp (f'∙a))"
by (simp add: val_Zp_def)
then have " ((2 * val_Zp (f'∙a)) + 2 ^ n * (val_Zp (f∙a) - 2 * val_Zp (f'∙a)))
≥ (val_Zp (f∙a) )"
by simp
then show " ((2 * val_Zp (f'∙a)) + 2 ^ n * (val_Zp (f∙a) - 2 * val_Zp (f'∙a)))
≥ (val_Zp (f'∙a) )"
using hensel_hypothesis_weakened by auto
qed
have A21:"val_Zp (f∙(ns n)) ≥ (2 * val_Zp (f'∙a)) + 2 ^ n * (val_Zp (f∙a) - 2 * val_Zp (f'∙a))"
using Suc.IH unfolding hensel_factor_def
by blast
show ?thesis using A21 A20
by auto
qed
have A3: "ns n ∈ carrier Zp"
using Suc.IH by blast
have A4: "val_Zp (f∙(ns n)) ≥val_Zp (f'∙(ns n))"
using A1 A2
by presburger
have A5: "f∙(ns n) ∈ carrier Zp"
by (simp add: F1 UP_cring.to_fun_closed Zp_x_is_UP_cring)
have A6: "(f'∙(ns n)) ∈ nonzero Zp"
proof-
have "(f'∙(ns n)) ∈ carrier Zp"
by (simp add: F1 UP_cring.to_fun_closed Zp_x_is_UP_cring f'_closed)
have "val_Zp (f'∙(ns n)) ≠ ∞"
using A1
by (simp add: val_Zp_def)
then show ?thesis
using ‹f' ∙ ns n ∈ carrier Zp› not_nonzero_Zp val_Zp_def
by meson
qed
have A7: " (divide (f∙ (ns n)) (f'∙(ns n))) ∈ carrier Zp"
using A5 A6 A4 A3 F5 by linarith
then show ?thesis
using A0 A3 cring.cring_simprules(4)
by (simp add: F1 F5 cring.cring_simprules(4))
qed
have P1: "val_Zp (f' ∙ ns k) = val_Zp (f'∙a) "
proof(cases "(f' ∙ ns k) = (f' ∙ ns n)")
case True
then show ?thesis using Suc.IH
by (metis order_refl)
next
case False
have "val_Zp ((f' ∙ ns k) ⊖ (f' ∙ ns n)) ≥ val_Zp ((ns k) ⊖ (ns n))"
using False P0 f'_closed poly_diff_val Suc.IH
by blast
then have "val_Zp ((f' ∙ ns k) ⊖ (f' ∙ ns n)) ≥ val_Zp (⊖ divide (f∙(ns n))(f'∙(ns n)))"
using F4 by metis
then have "val_Zp ((f' ∙ ns k) ⊖ (f' ∙ ns n)) ≥ val_Zp (divide (f∙(ns n))(f'∙(ns n)))"
using F5 val_Zp_of_minus
by presburger
then have P10: "val_Zp ((f' ∙ ns k) ⊖ (f' ∙ ns n)) ≥ val_Zp (f∙(ns n)) - val_Zp (f'∙(ns n))"
using F7 by metis
have P11: "val_Zp (f'∙(ns n)) ≠ ∞"
by (simp add: F2)
then have "val_Zp ((f' ∙ ns k) ⊖ (f' ∙ ns n)) ≥ (2 * val_Zp (f'∙a)) + 2 ^ n * t - val_Zp (f'∙(ns n))"
using F3 P10
by (smt eint_add_cancel_fact eint_add_left_cancel_le order_trans)
then have P12: "val_Zp ((f' ∙ ns k) ⊖ (f' ∙ ns n)) ≥ (2 *(val_Zp (f'∙a))) + 2 ^ n * t - (val_Zp (f'∙a))"
by (simp add: F2)
have P13:"val_Zp ((f' ∙ ns k) ⊖ (f' ∙ ns n)) ≥ (val_Zp (f'∙a)) + 2 ^ n * t "
proof-
have "(2 *(val_Zp (f'∙a))) + (2 ^ n * t) - (val_Zp (f'∙a)) = (2 *(val_Zp (f'∙a))) - (val_Zp (f'∙a)) + (2 ^ n * t) "
using eint_minus_comm by blast
then show ?thesis using P12
using f'a_not_infinite by force
qed
then have P14: "val_Zp ((f' ∙ ns k) ⊖ (f' ∙ ns n)) > (val_Zp (f'∙a))"
using f'a_not_infinite ge_plus_pos_imp_gt t_times_pow_pos by blast
show ?thesis
by (meson F1 F2 P0 P14 equal_val_Zp f'_closed f'a_closed to_fun_closed)
qed
have P2: "val_Zp (f∙(ns k)) ≥ 2*(val_Zp (f'∙a)) + (2^k)*t"
proof-
have P23: "2 * (val_Zp (f'∙a)) + ((2 ^ k) * t) ≤ val_Zp (f ∙ ns k)"
proof-
have 0: "ns n ∈ carrier Zp"
by (simp add: F1)
have 1: "local.divide (f ∙ ns n) (f' ∙ ns n) ∈ carrier Zp"
using F5 by blast
have 2: "(poly_shift_iter 2 (taylor (ns n) f)) ∙ ⊖ local.divide (f ∙ ns n) (f' ∙ ns n) ∈ carrier Zp"
using F1 F5 shift_closed 1
by (simp add: taylor_closed to_fun_closed)
have 3: "divide (f ∙ ns n) (f' ∙ ns n) ⊗ deriv f (ns n) = f ∙ ns n"
by (metis F1 F2 F6 divide_formula f'_closed f'a_not_infinite f_closed mult_comm pderiv_eval_deriv to_fun_closed val_Zp_def)
have 4: "f ∈ carrier Zp_x"
by simp
obtain c where c_def: "c = poly_shift_iter (2::nat) (taylor (ns n) f) ∙ ⊖ local.divide (f ∙ ns n) (f' ∙ ns n)"
by blast
then have c_def': "c ∈ carrier Zp ∧ f ∙ (ns n ⊖ local.divide (f ∙ ns n) (f' ∙ ns n)) = c ⊗ local.divide (f ∙ ns n) (f' ∙ ns n) [^] (2::nat)"
using 0 1 2 3 4 UP_cring.taylor_deg_1_eval'''[of Zp f "ns n" "(divide (f∙(ns n)) (f'∙(ns n)))" c]
Zp_x_is_UP_cring
by blast
have P230: "f∙(ns k) = (c ⊗ (divide (f∙(ns n)) (f'∙(ns n)))[^](2::nat))"
using c_def'
by (simp add: kval newton_step_def)
have P231: "val_Zp (f∙(ns k)) = val_Zp c + 2*(val_Zp (f∙(ns n)) - val_Zp(f'∙(ns n)))"
proof-
have P2310: "val_Zp (f∙(ns k)) = val_Zp c + val_Zp ((divide (f∙(ns n)) (f'∙(ns n)))[^](2::nat))"
by (simp add: F5 P230 c_def' val_Zp_mult)
have P2311: "val_Zp ((divide (f∙(ns n)) (f'∙(ns n)))[^](2::nat))
= 2*(val_Zp (f∙(ns n)) - val_Zp(f'∙(ns n)))"
by (metis F5 F7 R.pow_zero mult.commute not_nonzero_Zp of_nat_numeral times_eint_simps(3) val_Zp_def val_Zp_pow' zero_less_numeral)
thus ?thesis
by (simp add: P2310)
qed
have P232: "val_Zp (f∙(ns k)) ≥ 2*(val_Zp (f∙(ns n)) - val_Zp(f'∙(ns n)))"
by (simp add: P231 c_def' val_pos)
have P236: "val_Zp (f∙(ns k)) ≥ 2*(2 *val_Zp (f'∙a) + 2 ^ n * t) - 2* val_Zp(f'∙(ns n))"
using P232 F3 eint_minus_ineq''[of "val_Zp(f'∙(ns n))" "(2 *val_Zp (f'∙a)) + 2 ^ n * t" "val_Zp (f∙(ns n))" 2 ]
F2 eint_pow_int_is_pos by auto
hence P237: "val_Zp (f∙(ns k)) ≥(4*val_Zp (f'∙a)) + (2*((2 ^ n)* t)) - 2* val_Zp(f'∙(ns n))"
proof-
have "2*(2*val_Zp (f'∙a) + 2 ^ n * t) = (4*val_Zp (f'∙a)) + 2*(2 ^ n)* t "
using distrib_left[of 2 "2*val_Zp (f'∙a)" "2 ^ n * t"] mult.assoc mult_one_right one_eint_def plus_eint_simps(1)
hensel_factor_def val_Zp_def by auto
then show ?thesis
using P236
by (metis mult.assoc)
qed
hence P237: "val_Zp (f∙(ns k)) ≥ 4*val_Zp (f'∙a) + 2*(2 ^ n)* t - 2* val_Zp((f'∙a))"
by (metis F2 mult.assoc)
hence P238: "val_Zp (f∙(ns k)) ≥ 2*val_Zp (f'∙a) + 2*(2 ^ n)* t"
using eint_minus_comm[of "4*val_Zp (f'∙a) " "2*(2 ^ n)* t" "2* val_Zp((f'∙a))"]
by (simp add: eint_int_minus_distr)
thus ?thesis
by (simp add: kval)
qed
thus ?thesis
by blast
qed
show "val_Zp (to_fun f' (ns k)) = val_Zp (f'∙a) ∧
2 * val_Zp (f'∙a) + eint (2 ^ k) * t ≤ val_Zp (to_fun f (ns k))"
using P1 P2 by blast
qed
qed
qed
lemma newton_seq_closed:
shows "ns m ∈ carrier Zp"
using newton_seq_props_induct
by blast
lemma f_of_newton_seq_closed:
shows "f ∙ ns m ∈ carrier Zp"
by (simp add: to_fun_closed newton_seq_closed)
lemma newton_seq_fact1[simp]:
" val_Zp (f'∙(ns k)) = val_Zp ((f'∙a))"
using newton_seq_props_induct by blast
lemma newton_seq_fact2:
"⋀k. val_Zp (f∙(ns k)) ≥ 2*(val_Zp (f'∙a)) + (2^k)*t"
by (meson le_iff_add newton_seq_props_induct)
lemma newton_seq_fact3:
"val_Zp (f∙(ns l)) ≥ val_Zp (f'∙(ns l))"
proof-
have "2*(val_Zp (f'∙a)) + (2^l)*t ≥ (val_Zp (f'∙a))"
using f'a_closed ord_pos t_pos
by (smt eint_pos_int_times_ge f'a_nonneg_val f'a_not_infinite ge_plus_pos_imp_gt linorder_not_less nat_mult_not_infty order_less_le t_times_pow_pos)
then show "val_Zp (f ∙ ns l) ≥ val_Zp (f' ∙ ns l) "
using f'a_closed f'a_nonzero newton_seq_fact1[of l] newton_seq_fact2[of l] val_Zp_def
proof -
show ?thesis
using ‹eint 2 * val_Zp (f'∙a) + eint (2 ^ l) * t ≤ val_Zp (to_fun f (ns l))› ‹val_Zp (f'∙a) ≤ eint 2 * val_Zp (f'∙a) + eint (2 ^ l) * t› by force
qed
qed
lemma newton_seq_fact4[simp]:
assumes "f∙(ns l) ≠𝟬"
shows "val_Zp (f∙(ns l)) ≥ val_Zp (f'∙(ns l))"
using newton_seq_fact3 by blast
lemma newton_seq_fact5:
"divide (f ∙ ns l) (f' ∙ ns l) ∈ carrier Zp"
apply(rule divide_closed)
apply (simp add: to_fun_closed newton_seq_closed)
apply (simp add: f'_closed to_fun_closed newton_seq_closed)
by (metis f'a_not_infinite newton_seq_fact1 val_Zp_def)
lemma newton_seq_fact6:
"(f'∙(ns l)) ∈ nonzero Zp"
apply(rule ccontr)
using nonzero_memI nonzero_memE
f'a_nonzero newton_seq_fact1 val_Zp_def
by (metis (no_types, lifting) divide_closed f'_closed f'a_closed fa_closed hensel_factor_id
hensel_hypothesis_weakened mult_zero_l newton_seq_closed order_less_le to_fun_closed val_Zp_mult)
lemma newton_seq_fact7:
"(ns (Suc n)) ⊖ (ns n) = ⊖divide (f∙(ns n)) (f'∙(ns n))"
using newton_seq.simps(2)[of n] newton_seq_fact5[of n]
newton_seq_closed[of "Suc n"] newton_seq_closed[of n]
R.ring_simprules
unfolding newton_step_def a_minus_def
by smt
lemma newton_seq_fact8:
assumes "f∙(ns l) ≠𝟬"
shows "divide (f ∙ ns l) (f' ∙ ns l) ∈ nonzero Zp"
using assms divide_nonzero[of "f ∙ ns l" "f' ∙ ns l"]
nonzero_memI
using f_of_newton_seq_closed newton_seq_fact3 newton_seq_fact6 by blast
lemma newton_seq_fact9:
assumes "f∙(ns n) ≠𝟬"
shows "val_Zp((ns (Suc n)) ⊖ (ns n)) = val_Zp (f∙(ns n)) - val_Zp (f'∙(ns n))"
using newton_seq_fact7 val_of_divide newton_seq_fact6 assms nonzero_memI
f_of_newton_seq_closed newton_seq_fact4 newton_seq_fact5
by (metis val_Zp_of_minus)
text‹Assuming no element of the Newton sequence is a root of f, the Newton sequence is Cauchy.›
lemma newton_seq_is_Zp_cauchy_0:
assumes "⋀k. f∙(ns k) ≠𝟬"
shows "is_Zp_cauchy ns"
proof(rule is_Zp_cauchyI')
show P0: "ns ∈ closed_seqs Zp"
proof(rule closed_seqs_memI)
show "⋀k. ns k ∈ carrier Zp "
by (simp add: newton_seq_closed)
qed
show "∀n. ∃k. ∀m. k ≤ int m ⟶ int n ≤ val_Zp (ns (Suc m) ⊖ ns m)"
proof
fix n
show "∃k. ∀m. k ≤ int m ⟶ int n ≤ val_Zp (ns (Suc m) ⊖ ns m)"
proof(induction "n")
case 0
have B0: "∀n0 n1. 0 < n0 ∧ 0 < n1 ⟶ ns n0 0 = ns n1 0"
apply auto
proof-
fix n0 n1::nat
assume A: "0 < n0" "0 < n1"
show "ns n0 0 = ns n1 0"
proof-
have 0: "ns n0 ∈ carrier Zp"
using P0
by (simp add: newton_seq_closed)
have 1: "ns n1 ∈ carrier Zp"
using P0
by (simp add: newton_seq_closed)
show ?thesis
using 0 1 Zp_defs(3) prime
by (metis p_res_ring_0' residue_closed)
qed
qed
have "∀m. 1 ≤ int m ⟶ int 0 ≤ val_Zp_dist (newton_step (ns m)) (ns m)"
proof
fix m
show "1 ≤ int m ⟶ int 0 ≤ val_Zp_dist (newton_step (ns m)) (ns m)"
proof
assume "1 ≤ int m "
then have C0:"ns (Suc m) 0 = ns m 0"
using B0
by (metis int_one_le_iff_zero_less int_ops(1) less_Suc_eq_0_disj of_nat_less_iff)
then show "int 0 ≤ val_Zp_dist (newton_step (ns m)) (ns m)"
proof-
have "(newton_step (ns m)) ≠(ns m)"
proof-
have A0: "divide (f∙(ns m)) (f'∙(ns m)) ≠𝟬"
proof-
have 0: "(f∙(ns m)) ≠ 𝟬"
using assms by auto
have 1: " (f'∙(ns m)) ∈ carrier Zp"
by (simp add: UP_cring.to_fun_closed Zp_x_is_UP_cring f'_closed newton_seq_closed)
have 2: "(f'∙(ns m)) ≠ 𝟬"
using newton_seq_fact6 not_nonzero_memI by blast
show ?thesis using 0 1 2
by (metis R.r_null divide_formula f_closed to_fun_closed newton_seq_closed newton_seq_fact4)
qed
have A2: "local.divide (f ∙ ns m) (f' ∙ ns m) ∈ carrier Zp"
using newton_seq_fact5 by blast
have A3: "ns m ∈ carrier Zp"
by (simp add: newton_seq_closed)
have A4: "newton_step (ns m) ∈ carrier Zp"
by (metis newton_seq.simps(2) newton_seq_closed)
show ?thesis
apply(rule ccontr)
using A4 A3 A2 A0 newton_step_def[of "(ns m)"]
by (simp add: a_minus_def)
qed
then show ?thesis using C0
by (metis newton_seq.simps(2) newton_seq_closed val_Zp_dist_res_eq2)
qed
qed
qed
then show ?case
using val_Zp_def val_Zp_dist_def
by (metis int_ops(1) newton_seq.simps(2) zero_eint_def)
next
case (Suc n)
show "∃k. ∀m. k ≤ int m ⟶ int (Suc n) ≤ val_Zp (ns (Suc m) ⊖ ns m)"
proof-
obtain k0 where k0_def: "k0 ≥0 ∧ (∀m. k0 ≤ int m ⟶ int n ≤ val_Zp (ns (Suc m) ⊖ ns m))"
using Suc.IH
by (metis int_nat_eq le0 nat_le_iff of_nat_0_eq_iff )
have I0: "⋀l. val_Zp (ns (Suc l) ⊖ ns l) = val_Zp (f∙ (ns l)) - val_Zp (f'∙(ns l))"
proof-
fix l
have I00:"(ns (Suc l) ⊖ ns l) = (⊖ divide (f∙(ns l)) (f'∙(ns l)))"
proof-
have "local.divide (f ∙ ns l) (f' ∙ ns l) ∈ carrier Zp"
by (simp add: newton_seq_fact5)
then show ?thesis
using newton_seq.simps(2)[of l] newton_seq_closed R.ring_simprules
unfolding newton_step_def a_minus_def
by (metis add_comm)
qed
have I01: "val_Zp (ns (Suc l) ⊖ ns l) = val_Zp (divide (f∙(ns l)) (f'∙(ns l)))"
proof-
have I010: "(divide (f∙(ns l)) (f'∙(ns l))) ∈carrier Zp"
by (simp add: newton_seq_fact5)
have I011: "(divide (f∙(ns l)) (f'∙(ns l))) ≠ 𝟬"
proof-
have A: "(f∙(ns l)) ≠𝟬"
by (simp add: assms)
have B: " (f'∙(ns l)) ∈carrier Zp"
using nonzero_memE newton_seq_fact6 by auto
then have C: " (f'∙(ns l)) ∈nonzero Zp"
using f'a_closed fa_closed fa_nonzero hensel_factor_id hensel_hypothesis_weakened
newton_seq_fact1[of l] not_nonzero_Zp val_Zp_def
by fastforce
then show ?thesis using I010 A
by (metis B R.r_null divide_formula f_closed to_fun_closed newton_seq_closed newton_seq_fact4 nonzero_memE(2))
qed
then have "val_Zp (divide (f∙(ns l)) (f'∙(ns l)))
= val_Zp (⊖ divide (f∙(ns l)) (f'∙(ns l)))"
using I010 not_nonzero_Zp val_Zp_of_minus by blast
then show ?thesis using I00 by metis
qed
have I02: "val_Zp (f∙(ns l)) ≥ val_Zp (f'∙(ns l))"
using assms newton_seq_fact4
by blast
have I03: "(f∙(ns l)) ∈ nonzero Zp"
by (meson UP_cring.to_fun_closed Zp_x_is_UP_cring assms f_closed newton_seq_closed not_nonzero_Zp)
have I04: "f'∙(ns l) ∈ nonzero Zp"
by (simp add: newton_seq_fact6)
have I05 :" val_Zp (divide (f∙(ns l)) (f'∙(ns l))) = val_Zp (f∙ (ns l)) - val_Zp (f'∙(ns l))"
using I02 I03 I04 I01 assms newton_seq_fact9 by auto
then show " val_Zp (ns (Suc l) ⊖ ns l) = val_Zp (f∙ (ns l)) - val_Zp (f'∙(ns l))"
using I01 by simp
qed
have "∀m. int(Suc n) + k0 + 1 ≤ int m ⟶ int (Suc n) ≤ val_Zp_dist (newton_step (ns m)) (ns m)"
proof
fix m
show "int (Suc n) + k0 + 1 ≤ int m ⟶ int (Suc n) ≤ val_Zp_dist (newton_step (ns m)) (ns m)"
proof
assume A: "int (Suc n) + k0 + 1 ≤ int m "
show " int (Suc n) ≤ val_Zp_dist (newton_step (ns m)) (ns m)"
proof-
have 0: " val_Zp_dist (newton_step (ns m)) (ns m) = val_Zp (f∙ (ns m)) - val_Zp (f'∙(ns m))"
using I0 val_Zp_dist_def by auto
have 1: "val_Zp (f∙ (ns m)) - val_Zp (f'∙(ns m)) > int n"
proof-
have "val_Zp (f∙ (ns m)) ≥ 2*(val_Zp (f'∙a)) + (2^m)*t"
by (simp add: newton_seq_fact2)
then have 10:"val_Zp (f∙ (ns m)) - val_Zp (f'∙(ns m)) ≥ 2*(val_Zp (f'∙a)) + (2^m)*t - val_Zp (f'∙(ns m))"
by (simp add: eint_minus_ineq)
have "2^m * t > m"
apply(induction m)
using one_eint_def zero_eint_def apply auto[1]
proof- fix m
assume IH : "int m < 2 ^ m * t "
then have "((2 ^ (Suc m)) * t) = 2* ((2 ^ m) * t)"
by (metis mult.assoc power_Suc times_eint_simps(1))
then show "int (Suc m) < 2 ^ Suc m * t"
using IH t_neq_infty by force
qed
then have 100: "2^m * t > int m"
by blast
have "int m ≥2 + (int n + k0)"
using A by simp
hence 1000: "2^m * t > 2 + (int n + k0)"
using 100
by (meson eint_ord_simps(2) less_le_trans linorder_not_less)
have "2 + (int n + k0) > 1 + int n"
using k0_def by linarith
then have "2^m * t > 1 + int n"
using 1000 eint_ord_simps(2) k0_def less_le_trans linorder_not_less
proof -
have "eint (2 + (int n + k0)) < t * eint (int (2 ^ m))"
by (metis "1000" mult.commute numeral_power_eq_of_nat_cancel_iff)
then have "eint (int (Suc n)) < t * eint (int (2 ^ m))"
by (metis ‹1 + int n < 2 + (int n + k0)› eint_ord_simps(2) less_trans of_nat_Suc)
then show ?thesis
by (simp add: mult.commute)
qed
hence "2*val_Zp (f'∙a) + eint (2 ^ m) * t ≥ 2*(val_Zp (f'∙a)) + 1 + int n"
by (smt eSuc_eint eint_add_left_cancel_le iadd_Suc iadd_Suc_right order_less_le)
then have 11: "val_Zp (f∙ (ns m)) - val_Zp (f'∙(ns m))
≥ 2*(val_Zp (f'∙a)) + 1 + int n - val_Zp (f'∙(ns m))"
using "10"
by (smt ‹eint 2 * val_Zp (f'∙a) + eint (2 ^ m) * t ≤ val_Zp (to_fun f (ns m))›
f'a_not_infinite eint_minus_ineq hensel_axioms newton_seq_fact1 order_trans)
have 12: "val_Zp (f'∙(ns m)) = val_Zp (f'∙a) "
using nonzero_memE newton_seq_fact1 newton_seq_fact6 val_Zp_def val_Zp_def
by auto
then have 13: "val_Zp (f∙ (ns m)) - val_Zp (f'∙(ns m))
≥ 2*(val_Zp (f'∙a)) + (1 + int n) - val_Zp ((f'∙a))"
using 11
by (smt eSuc_eint iadd_Suc iadd_Suc_right)
then have 14:"val_Zp (f∙ (ns m)) - val_Zp (f'∙(ns m))
≥ 1 + int n + val_Zp ((f'∙a))"
using eint_minus_comm[of "2*(val_Zp (f'∙a))" "1 + int n" "val_Zp ((f'∙a))"]
by (simp add: Groups.add_ac(2))
then show ?thesis
by (smt Suc_ile_eq add.right_neutral eint.distinct(2) f'a_nonneg_val ge_plus_pos_imp_gt order_less_le)
qed
then show ?thesis
by (smt "0" Suc_ile_eq of_nat_Suc)
qed
qed
qed
then show ?thesis
using val_Zp_def val_Zp_dist_def
by (metis newton_seq.simps(2))
qed
qed
qed
qed
lemma eventually_zero:
"f ∙ ns (k + m) = 𝟬 ⟹ f ∙ ns (k + Suc m) = 𝟬"
proof-
assume A: "f ∙ ns (k + m) = 𝟬"
have 0: "ns (k + Suc m) = ns (k + m) ⊖ (divide (f ∙ ns (k + m)) (f' ∙ ns (k + m)))"
by (simp add: newton_step_def)
have 1: "(divide (f ∙ ns (k + m)) (f' ∙ ns (k + m))) = 𝟬"
by (simp add: A divide_def)
show "f ∙ ns (k + Suc m) = 𝟬"
using A 0 1
by (simp add: a_minus_def newton_seq_closed)
qed
text‹The Newton Sequence is Cauchy:›
lemma newton_seq_is_Zp_cauchy:
"is_Zp_cauchy ns"
proof(cases "∀k. f∙(ns k) ≠𝟬")
case True
then show ?thesis using newton_seq_is_Zp_cauchy_0
by blast
next
case False
obtain k where k_def:"f∙(ns k) = 𝟬"
using False by blast
have 0: "⋀m. (ns (m + k)) = (ns k)"
proof-
fix m
show "(ns (m + k)) = (ns k)"
proof(induction m)
case 0
then show ?case
by simp
next
case (Suc m)
show "(ns (Suc m + k)) = (ns k)"
proof-
have "f ∙ ns (m + k) = 𝟬"
by (simp add: Suc.IH k_def)
then have "divide ( f ∙ ns (m + k)) (f' ∙ ns (m + k)) = 𝟬"
by (simp add: divide_def)
then show ?thesis using newton_step_def
by (simp add: Suc.IH a_minus_def newton_seq_closed)
qed
qed
qed
show "is_Zp_cauchy ns"
apply(rule is_Zp_cauchyI)
apply (simp add: closed_seqs_memI newton_seq_closed)
proof-
show "⋀n.⋀n. ∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ ns n0 n = ns n1 n"
proof-
fix n
show "∃N. ∀n0 n1. N < n0 ∧ N < n1 ⟶ ns n0 n = ns n1 n"
proof-
have "∀n0 n1. k < n0 ∧ k < n1 ⟶ ns n0 n = ns n1 n"
apply auto
proof-
fix n0 n1
assume A0: "k < n0"
assume A1: "k < n1"
obtain m0 where m0_def: "n0 = k + m0"
using A0 less_imp_add_positive by blast
obtain m1 where m1_def: "n1 = k + m1"
using A1 less_imp_add_positive by auto
show "ns n0 n = ns n1 n"
using 0 m0_def m1_def
by (metis add.commute)
qed
then show ?thesis by blast
qed
qed
qed
qed
subsection‹The Proof of Hensel's Lemma›
lemma pre_hensel:
"val_Zp (a ⊖ (ns n)) > val_Zp (f'∙a)"
"∃N. ∀n. n> N ⟶ (val_Zp (a ⊖ (ns n)) = val_Zp (divide (f∙a) (f'∙a)))"
"val_Zp (f'∙(ns n)) = val_Zp (f'∙a)"
proof-
show "val_Zp (a ⊖ (ns n)) > val_Zp (f'∙a)"
proof(induction n)
case 0
then show ?case
by (simp add: val_Zp_def)
next
case (Suc n)
show "val_Zp (a ⊖ (ns (Suc n))) > val_Zp (f'∙a)"
proof-
have I0: "val_Zp ((ns (Suc n)) ⊖ (ns n)) > val_Zp (f'∙a)"
proof(cases "(ns (Suc n)) = (ns n)")
case True
then show ?thesis
by (simp add: newton_seq_closed val_Zp_def)
next
case False
have 00:"(ns (Suc n)) ⊖ (ns n) = ⊖divide (f∙(ns n)) (f'∙(ns n))"
using newton_seq_fact7 by blast
then have 0: "val_Zp((ns (Suc n)) ⊖ (ns n)) = val_Zp (divide (f∙(ns n)) (f'∙(ns n)))"
using newton_seq_fact5 val_Zp_of_minus by presburger
have 1: "(f∙(ns n)) ∈ nonzero Zp"
by (metis False R.minus_zero R.r_right_minus_eq 00 divide_def f_closed to_fun_closed
newton_seq_closed not_nonzero_Zp)
have 2: "f'∙(ns n) ∈ nonzero Zp"
by (simp add: newton_seq_fact6)
have "val_Zp (f∙(ns n)) ≥ val_Zp (f'∙(ns n))"
using nonzero_memE ‹f ∙ ns n ∈ nonzero Zp› newton_seq_fact4 by blast
then have 3:"val_Zp((ns (Suc n)) ⊖ (ns n)) = val_Zp (f∙(ns n)) - val_Zp (f'∙(ns n))"
using 0 1 2 newton_seq_fact9 nonzero_memE(2) by blast
have 4: "val_Zp (f ∙ ns n) ≥ (2 * val_Zp (f'∙a)) + 2 ^ n * t"
using newton_seq_fact2[of n] by metis
then have 5: "val_Zp((ns (Suc n)) ⊖ (ns n)) ≥ ((2 * val_Zp (f'∙a)) + 2 ^ n * t) - val_Zp (f'∙(ns n))"
using "3" eint_minus_ineq f'a_not_infinite newton_seq_fact1 by presburger
have 6: "((ns (Suc n)) ⊖ (ns n)) ∈ nonzero Zp"
using False not_eq_diff_nonzero newton_seq_closed by blast
then have "val_Zp((ns (Suc n)) ⊖ (ns n)) ≥ (2 * val_Zp (f'∙a)) + 2 ^ n * t - val_Zp ((f'∙a))"
using "5" by auto
then have 7: "val_Zp((ns (Suc n)) ⊖ (ns n)) ≥ (val_Zp (f'∙a)) + 2 ^ n * t"
by (simp add: eint_minus_comm)
then show "val_Zp((ns (Suc n)) ⊖ (ns n)) > (val_Zp (f'∙a))"
using f'a_not_infinite ge_plus_pos_imp_gt t_times_pow_pos by blast
qed
have "val_Zp ((ns (Suc n)) ⊖ (ns n)) = val_Zp ((ns n) ⊖ (ns (Suc n)))"
using newton_seq_closed[of "n"] newton_seq_closed[of "Suc n"]
val_Zp_def val_Zp_dist_def val_Zp_dist_sym val_Zp_def
by auto
then have I1: "val_Zp ((ns n) ⊖ (ns (Suc n))) > val_Zp (f'∙a)"
using I0
by presburger
have I2: " (a ⊖ (ns n)) ⊕ ((ns n) ⊖ (ns (Suc n))) = (a ⊖ (ns (Suc n)))"
by (metis R.plus_diff_simp add_comm local.a_closed newton_seq_closed)
then have "val_Zp (a ⊖ (ns (Suc n))) ≥ min (val_Zp (a ⊖ ns n)) (val_Zp (ns n ⊖ ns (Suc n)))"
by (metis R.minus_closed local.a_closed newton_seq_closed val_Zp_ultrametric)
thus ?thesis
using I1 Suc.IH eint_min_ineq by blast
qed
qed
show "val_Zp (f'∙(ns n)) = val_Zp (f'∙a)"
using newton_seq_fact1 by blast
show "∃N.∀n. n> N ⟶ (val_Zp (a ⊖ (ns n)) = val_Zp (divide (f∙a) (f'∙a)))"
proof-
have P: "⋀m. m > 1 ⟹ (val_Zp (a ⊖ (ns m)) = val_Zp (divide (f∙a) (f'∙a)))"
proof-
fix n::nat
assume AA: "n >1"
show " (val_Zp (a ⊖ (ns n)) = val_Zp (divide (f∙a) (f'∙a)))"
proof(cases "(ns 1) = a")
case True
have T0: "⋀k. ∀n. n ≤ k ⟶ ns n = a"
proof-
fix k
show " ∀n. n ≤ k ⟶ ns n = a"
proof(induction k)
case 0
then show ?case
by simp
next
case (Suc k)
show "∀n≤Suc k. ns n = a" apply auto
proof-
fix n
assume A: "n ≤Suc k"
show "ns n = a"
proof(cases "n < Suc k")
case True
then show ?thesis using Suc.IH by auto
next
case False thus ?thesis
using A Suc.IH True by auto
qed
qed
qed
qed
show "val_Zp (a ⊖ ns n) = val_Zp (local.divide (f∙a) (f'∙a))"
by (metis T0 Zp_def Zp_defs(3) f'a_closed f'a_nonzero fa_nonzero
hensel.fa_closed hensel_axioms hensel_hypothesis_weakened le_eq_less_or_eq
newton_seq_fact9 not_nonzero_Qp order_less_le val_of_divide)
next
case False
have F0: "(1::nat) ≤ n"
using AA by simp
have "(f∙a) ≠ 𝟬"
by simp
have "⋀k. val_Zp (a ⊖ ns (Suc k)) = val_Zp (local.divide (f∙a) (f'∙a))"
proof-
fix k
show " val_Zp (a ⊖ ns (Suc k)) = val_Zp (local.divide (f∙a) (f'∙a))"
proof(induction k)
case 0
have "(a ⊖ ns (Suc 0)) = (local.divide (f∙a) (f'∙a))"
by (metis R.minus_minus Zp_def hensel.newton_seq_fact7 hensel_axioms
local.a_closed minus_a_inv newton_seq.simps(1) newton_seq.simps(2) newton_seq_fact5 newton_step_closed)
then show ?case by simp
next
case (Suc k)
have I0: "ns (Suc (Suc k)) = ns (Suc k) ⊖ (divide (f∙(ns (Suc k))) (f'∙(ns (Suc k))))"
by (simp add: newton_step_def)
have I1: "val_Zp (f∙(ns (Suc k))) ≥ val_Zp(f'∙(ns (Suc k)))"
using newton_seq_fact3 by blast
have I2: "(divide (f∙(ns (Suc k))) (f'∙(ns (Suc k)))) ∈ carrier Zp"
using newton_seq_fact5 by blast
have I3: "ns (Suc (Suc k)) ⊖ ns (Suc k) = ⊖(divide (f∙(ns (Suc k))) (f'∙(ns (Suc k))))"
using I0 I2 newton_seq_fact7 by blast
then have "val_Zp (ns (Suc (Suc k)) ⊖ ns (Suc k)) = val_Zp (divide (f∙(ns (Suc k))) (f'∙(ns (Suc k))))"
using I2 val_Zp_of_minus
by presburger
then have "val_Zp (ns (Suc (Suc k)) ⊖ ns (Suc k)) = val_Zp (f∙(ns (Suc k))) - val_Zp (f'∙(ns (Suc k)))"
by (metis I1 R.zero_closed Zp_def newton_seq_fact6 newton_seq_fact9 padic_integers.val_of_divide padic_integers_axioms)
then have I4: "val_Zp (ns (Suc (Suc k)) ⊖ ns (Suc k)) = val_Zp (f∙(ns (Suc k))) - val_Zp ((f'∙a))"
using newton_seq_fact1 by presburger
have F3: "val_Zp (a ⊖ ns (Suc k)) = val_Zp (local.divide (f∙a) (f'∙a))"
using Suc.IH by blast
have F4: "a ⊖ ns (Suc (Suc k)) = (a ⊖ ( ns (Suc k))) ⊕ (ns (Suc k)) ⊖ ns (Suc (Suc k))"
by (metis R.ring_simprules(17) a_minus_def add_comm local.a_closed newton_seq_closed)
have F5: "val_Zp ((ns (Suc k)) ⊖ ns (Suc (Suc k))) > val_Zp (a ⊖ ( ns (Suc k)))"
proof-
have F50: "val_Zp ((ns (Suc k)) ⊖ ns (Suc (Suc k))) = val_Zp (f∙(ns (Suc k))) - val_Zp ((f'∙a))"
by (metis I4 R.minus_closed minus_a_inv newton_seq_closed val_Zp_of_minus)
have F51: "val_Zp (f∙(ns (Suc k))) > val_Zp ((f∙a))"
proof-
have F510: "val_Zp (f∙(ns (Suc k))) ≥ 2*val_Zp (f'∙a) + 2^(Suc k)*t "
using newton_seq_fact2 by blast
hence F511: "val_Zp (f∙(ns (Suc k))) ≥ 2*val_Zp (f'∙a) + 2*t "
using eint_plus_times[of t "2*val_Zp (f'∙a)" "2^(Suc k)" "val_Zp (f∙(ns (Suc k)))" 2] t_pos
by (simp add: order_less_le)
have F512: "2*val_Zp (f'∙a) + 2*t = 2 *val_Zp (f∙a) - 2* val_Zp (f'∙a)"
unfolding hensel_factor_def
using eint_minus_distr[of "val_Zp (f∙a)" "2 * val_Zp (f'∙a)" 2]
eint_minus_comm[of _ _ "eint 2 * (eint 2 * val_Zp (f'∙a))"]
by (smt eint_2_minus_1_mult eint_add_cancel_fact eint_minus_comm f'a_not_infinite hensel_hypothesis nat_mult_not_infty order_less_le)
hence "2*val_Zp (f'∙a) + 2*t > val_Zp (f∙a)"
using hensel_hypothesis
by (smt add_diff_cancel_eint eint_add_cancel_fact eint_add_left_cancel_le
eint_pos_int_times_gt f'a_not_infinite hensel_factor_def nat_mult_not_infty order_less_le t_neq_infty t_pos)
thus ?thesis using F512
using F511 less_le_trans by blast
qed
thus ?thesis
by (metis F3 F50 Zp_def divide_closed eint_add_cancel_fact eint_minus_ineq
f'a_closed f'a_nonzero f'a_not_infinite fa_closed fa_nonzero hensel.newton_seq_fact7
hensel_axioms newton_seq.simps(1) newton_seq_fact9 order_less_le val_Zp_of_minus)
qed
have "a ⊖ ns (Suc k) ⊕ (ns (Suc k) ⊖ ns (Suc (Suc k))) = a ⊖ ns (Suc (Suc k))"
by (metis F4 a_minus_def add_assoc)
then show F6: "val_Zp (a ⊖ ns (Suc (Suc k))) = val_Zp (local.divide (f∙a) (f'∙a))"
using F5 F4 F3
by (metis R.minus_closed local.a_closed newton_seq_closed order_less_le val_Zp_not_equal_ord_plus_minus val_Zp_ultrametric_eq'')
qed
qed
thus ?thesis
by (metis AA less_imp_add_positive plus_1_eq_Suc)
qed
qed
thus ?thesis
by blast
qed
qed
lemma hensel_seq_comp_f:
"res_lim ((to_fun f) ∘ ns) = 𝟬"
proof-
have A: "is_Zp_cauchy ((to_fun f) ∘ ns)"
using f_closed is_Zp_continuous_def newton_seq_is_Zp_cauchy polynomial_is_Zp_continuous
by blast
have "Zp_converges_to ((to_fun f) ∘ ns) 𝟬"
apply(rule Zp_converges_toI)
using A is_Zp_cauchy_def apply blast
apply simp
proof-
fix n
show " ∃N. ∀k>N. (((to_fun f) ∘ ns) k) n = 𝟬 n"
proof-
have 0: "⋀k. (k::nat)>3 ⟶ val_Zp (f∙(ns k)) > k"
proof
fix k::nat
assume A: "k >3"
show "val_Zp (f∙(ns k)) > k "
proof-
have 0: " val_Zp (f∙(ns k)) ≥ 2*(val_Zp (f'∙a)) + (2^k)*t"
using newton_seq_fact2 by blast
have 1: "2*(val_Zp (f'∙a)) + (2^k)*t > k "
proof-
have "(2^k)*t ≥ (2^k) "
apply(cases "t = ∞")
apply simp
using t_pos eint_mult_mono'
proof -
obtain ii :: "eint ⇒ int" where
f1: "∀e. (∞ ≠ e ∨ (∀i. eint i ≠ e)) ∧ (eint (ii e) = e ∨ ∞ = e)"
by (metis not_infinity_eq)
then have "0 < ii t"
by (metis (no_types) eint_ord_simps(2) t_neq_infty t_pos zero_eint_def)
then show ?thesis
using f1 by (metis eint_pos_int_times_ge eint_mult_mono linorder_not_less
mult.commute order_less_le t_neq_infty t_pos t_times_pow_pos)
qed
hence " 2*(val_Zp (f'∙a)) + (2^k)*t ≥ (2^k) "
by (smt Groups.add_ac(2) add.right_neutral eint_2_minus_1_mult eint_pos_times_is_pos
eint_pow_int_is_pos f'a_nonneg_val ge_plus_pos_imp_gt idiff_0_right linorder_not_less
nat_mult_not_infty order_less_le t_neq_infty)
then have " 2*(val_Zp (f'∙a)) + (2^k)*t > k"
using A of_nat_1 of_nat_add of_nat_less_two_power
by (smt eint_ord_simps(1) linorder_not_less order_trans)
then show ?thesis
by metis
qed
thus ?thesis
using 0 less_le_trans by blast
qed
qed
have 1: "⋀k. (k::nat)>3 ⟶ (f∙(ns k)) k = 0"
proof
fix k::nat
assume B: "3<k"
show " (f∙(ns k)) k = 0"
proof-
have B0: " val_Zp (f∙(ns k)) > k"
using 0 B
by blast
then show ?thesis
by (simp add: f_of_newton_seq_closed zero_below_val_Zp)
qed
qed
have "∀k>(max 3 n). (((to_fun f) ∘ ns) k) n = 𝟬 n"
apply auto
proof-
fix k::nat
assume A: "3< k"
assume A': "n < k"
have A0: "(f∙(ns k)) k = 0"
using 1[of k] A by auto
then have "(f∙(ns k)) n = 0"
using A A'
using above_ord_nonzero[of "(f∙(ns k))"]
by (smt UP_cring.to_fun_closed Zp_x_is_UP_cring f_closed le_eq_less_or_eq
newton_seq_closed of_nat_mono residue_of_zero(2) zero_below_ord)
then show A1: "to_fun f (ns k) n = 𝟬 n"
by (simp add: residue_of_zero(2))
qed
then show ?thesis by blast
qed
qed
then show ?thesis
by (metis Zp_converges_to_def unique_limit')
qed
lemma full_hensels_lemma:
obtains α where
"f∙α = 𝟬" and "α ∈ carrier Zp"
"val_Zp (a ⊖ α) > val_Zp (f'∙a)"
"(val_Zp (a ⊖ α) = val_Zp (divide (f∙a) (f'∙a)))"
"val_Zp (f'∙α) = val_Zp (f'∙a)"
proof(cases "∃k. f∙(ns k) =𝟬")
case True
obtain k where k_def: "f∙(ns k) =𝟬"
using True by blast
obtain N where N_def: "∀n. n> N ⟶ (val_Zp (a ⊖ (ns n)) = val_Zp (divide (f∙a) (f'∙a)))"
using pre_hensel(2) by blast
have Z: "⋀n. n ≥k ⟹ f∙(ns n) =𝟬"
proof-
fix n
assume A: "n ≥k"
obtain l where l_def:"n = k + l"
using A le_Suc_ex
by blast
have "⋀m. f∙(ns (k+m)) =𝟬"
proof-
fix m
show "f∙(ns (k+m)) =𝟬"
apply(induction m)
apply (simp add: k_def)
using eventually_zero
by simp
qed
then show "f∙(ns n) =𝟬"
by (simp add: l_def)
qed
obtain M where M_def: "M = N + k"
by simp
then have M_root: "f∙(ns M) =𝟬"
by (simp add: Z)
obtain α where alpha_def: "α= ns M"
by simp
have T0: "f∙α = 𝟬"
using alpha_def M_root
by auto
have T1: "val_Zp (a ⊖ α) > val_Zp (f'∙a)"
using alpha_def pre_hensel(1) by blast
have T2: "(val_Zp (a ⊖ α) = val_Zp (divide (f∙a) (f'∙a)))"
by (metis M_def N_def alpha_def fa_nonzero k_def
less_add_same_cancel1 newton_seq.elims zero_less_Suc)
have T3: "val_Zp (f'∙α) = val_Zp (f'∙a)"
using alpha_def newton_seq_fact1 by blast
show ?thesis using T0 T1 T2 T3
using that alpha_def newton_seq_closed
by blast
next
case False
then have Nz: "⋀k. f∙(ns k) ≠𝟬"
by blast
have ns_cauchy: "is_Zp_cauchy ns"
by (simp add: newton_seq_is_Zp_cauchy)
have fns_cauchy: "is_Zp_cauchy ((to_fun f) ∘ ns)"
using f_closed is_Zp_continuous_def ns_cauchy polynomial_is_Zp_continuous by blast
have F0: "res_lim ((to_fun f) ∘ ns) = 𝟬"
proof-
show ?thesis
using hensel_seq_comp_f by auto
qed
obtain α where alpha_def: "α = res_lim ns"
by simp
have F1: "(f∙α)= 𝟬"
using F0 alpha_def alt_seq_limit
ns_cauchy polynomial_is_Zp_continuous res_lim_pushforward
res_lim_pushforward' by auto
have F2: "val_Zp (a ⊖ α) > val_Zp (f'∙a) ∧ val_Zp (a ⊖ α) = val_Zp (local.divide (f∙a) (f'∙a))"
proof-
have 0: "Zp_converges_to ns α"
by (simp add: alpha_def is_Zp_cauchy_imp_has_limit ns_cauchy)
have "val_Zp (a ⊖ α) < ∞"
using "0" F1 R.r_right_minus_eq Zp_converges_to_def Zp_def hensel.fa_nonzero hensel_axioms local.a_closed val_Zp_def
by auto
hence "1 + max (eint 2 + val_Zp (f'∙a)) (val_Zp (α ⊖ a)) < ∞"
by (metis "0" R.minus_closed Zp_converges_to_def eint.distinct(2) eint_ord_simps(4)
f'a_not_infinite infinity_ne_i1 local.a_closed max_def minus_a_inv
sum_infinity_imp_summand_infinity val_Zp_of_minus)
then obtain l where l_def: "eint l = 1 + max (eint 2 + val_Zp (f'∙a)) (val_Zp (α ⊖ a))"
by auto
then obtain N where N_def: "(∀m>N. 1 + max (2 + val_Zp (f'∙a)) (val_Zp (α ⊖ a)) < val_Zp_dist (ns m) α)"
using 0 l_def Zp_converges_to_def[of ns α] unfolding val_Zp_dist_def
by metis
obtain N' where N'_def: "∀n>N'. val_Zp (a ⊖ ns n) = val_Zp (local.divide (f∙a) (f'∙a))"
using pre_hensel(2) by blast
obtain K where K_def: "K = Suc (max N N')"
by simp
then have F21: "(1+ (max (2 + val_Zp (f'∙a)) (val_Zp (α ⊖ a)))) < val_Zp_dist (ns K) α"
by (metis N_def lessI linorder_not_less max_def order_trans)
have F22: "a ≠ ns K"
by (smt False K_def N'_def Zp_def cring_def eint.distinct(2) hensel_factor_id lessI
less_le_trans linorder_not_less max_def mult_comm mult_zero_l newton_seq_closed
order_less_le padic_int_is_cring padic_integers.prime padic_integers_axioms ring.r_right_minus_eq
val_Zp_def)
show ?thesis
proof(cases "ns K = α")
case True
then show ?thesis
using pre_hensel F1 False by blast
next
case False
assume "ns K ≠ α"
show ?thesis
proof-
have P0: " (a ⊖ α) ∈ nonzero Zp"
by (metis (mono_tags, hide_lams) F1 not_eq_diff_nonzero
‹Zp_converges_to ns α› a_closed Zp_converges_to_def fa_nonzero)
have P1: "(α ⊖ (ns K)) ∈ nonzero Zp"
using False not_eq_diff_nonzero ‹Zp_converges_to ns α›
Zp_converges_to_def newton_seq_closed
by (metis (mono_tags, hide_lams))
have P2: "a ⊖ (ns K) ∈ nonzero Zp"
using F22 not_eq_diff_nonzero
a_closed newton_seq_closed
by blast
have P3: "(a ⊖ α) = a ⊖ (ns K) ⊕ ((ns K) ⊖ α)"
by (metis R.plus_diff_simp ‹Zp_converges_to ns α› add_comm Zp_converges_to_def local.a_closed newton_seq_closed)
have P4: "val_Zp (a ⊖ α) ≥ min (val_Zp (a ⊖ (ns K))) (val_Zp ((ns K) ⊖ α))"
using "0" P3 Zp_converges_to_def newton_seq_closed val_Zp_ultrametric
by auto
have P5: "val_Zp (a ⊖ (ns K)) > val_Zp (f'∙a)"
using pre_hensel(1)[of "K"]
by metis
have "1 + max (eint 2 + val_Zp (f'∙a)) (val_Zp (α ⊖ a)) > val_Zp (f'∙a)"
proof-
have "1 + max (eint 2 + val_Zp (f'∙a)) (val_Zp (α ⊖ a)) > (eint 2 + val_Zp (f'∙a))"
proof -
obtain ii :: int where
f1: "eint ii = 1 + max (eint 2 + val_Zp (f'∙a)) (val_Zp (α ⊖ a))"
by (meson l_def)
then have "1 + (eint 2 + val_Zp (f'∙a)) ≤ eint ii"
by simp
then show ?thesis
using f1 by (metis Groups.add_ac(2) iless_Suc_eq linorder_not_less)
qed
thus ?thesis
by (smt Groups.add_ac(2) eint_pow_int_is_pos f'a_not_infinite ge_plus_pos_imp_gt order_less_le)
qed
hence P6: "val_Zp ((ns K) ⊖ α) > val_Zp (f'∙a)"
using F21 unfolding val_Zp_dist_def
by auto
have P7: "val_Zp (a ⊖ α) > val_Zp (f'∙a)"
using P4 P5 P6 eint_min_ineq by blast
have P8: "val_Zp (a ⊖ α) = val_Zp (local.divide (f∙a) (f'∙a))"
proof-
have " 1 + max (2 + val_Zp (f'∙a)) (val_Zp_dist α a) ≤ val_Zp_dist (ns K) α"
using False F21
by (simp add: val_Zp_dist_def)
then have "val_Zp(α ⊖ (ns K)) > max (2 + val_Zp (f'∙a)) (val_Zp_dist α a)"
by (metis "0" Groups.add_ac(2) P1 Zp_converges_to_def eSuc_mono iless_Suc_eq l_def
minus_a_inv newton_seq_closed nonzero_closed val_Zp_dist_def val_Zp_of_minus)
then have "val_Zp(α ⊖ (ns K)) > val_Zp (a ⊖ α) "
using ‹Zp_converges_to ns α› Zp_converges_to_def val_Zp_dist_def val_Zp_dist_sym
by auto
then have P80: "val_Zp (a ⊖ α) = val_Zp (a ⊖ (ns K))"
using P0 P1 Zp_def val_Zp_ultrametric_eq[of "α ⊖ ns K" "a ⊖ α"] 0 R.plus_diff_simp
Zp_converges_to_def local.a_closed newton_seq_closed nonzero_closed by auto
have P81: "val_Zp (a ⊖ ns K) = val_Zp (local.divide (f∙a) (f'∙a))"
using K_def N'_def
by (metis (no_types, lifting) lessI linorder_not_less max_def order_less_le order_trans)
then show ?thesis
by (simp add: P80)
qed
thus ?thesis
using P7 by blast
qed
qed
qed
have F3: "val_Zp (f' ∙ α) = val_Zp (f'∙a)"
proof-
have F31: " (f' ∙ α) = res_lim ((to_fun f') ∘ ns)"
using alpha_def alt_seq_limit ns_cauchy polynomial_is_Zp_continuous res_lim_pushforward
res_lim_pushforward' f'_closed
by auto
obtain N where N_def: "val_Zp (f'∙α ⊖ f'∙(ns N)) > val_Zp ((f'∙a))"
by (smt F2 False R.minus_closed Suc_ile_eq Zp_def alpha_def f'_closed f'a_nonzero
local.a_closed minus_a_inv newton_seq.simps(1) newton_seq_is_Zp_cauchy_0 order_trans
padic_integers.poly_diff_val padic_integers_axioms res_lim_in_Zp val_Zp_def val_Zp_of_minus)
show ?thesis
by (metis False N_def alpha_def equal_val_Zp f'_closed newton_seq_closed newton_seq_is_Zp_cauchy_0 newton_seq_fact1 res_lim_in_Zp to_fun_closed)
qed
show ?thesis
using F1 F2 F3 that alpha_def ns_cauchy res_lim_in_Zp
by blast
qed
end
section‹Removing Hensel's Lemma from the Hensel Locale›
context padic_integers
begin
lemma hensels_lemma:
assumes "f ∈ carrier Zp_x"
assumes "a ∈ carrier Zp"
assumes "(pderiv f)∙a ≠ 𝟬"
assumes "f∙a ≠𝟬"
assumes "val_Zp (f∙a) > 2* val_Zp ((pderiv f)∙a)"
obtains α where
"f∙α = 𝟬" and "α ∈ carrier Zp"
"val_Zp (a ⊖ α) > val_Zp ((pderiv f)∙a)"
"val_Zp (a ⊖ α) = val_Zp (divide (f∙a) ((pderiv f)∙a))"
"val_Zp ((pderiv f)∙α) = val_Zp ((pderiv f)∙a)"
proof-
have "hensel p f a"
using assms
by (simp add: Zp_def hensel.intro hensel_axioms.intro padic_integers_axioms)
then show ?thesis
using hensel.full_hensels_lemma Zp_def that
by blast
qed
text‹Uniqueness of the root found in Hensel's lemma ›
lemma hensels_lemma_unique_root:
assumes "f ∈ carrier Zp_x"
assumes "a ∈ carrier Zp"
assumes "(pderiv f)∙a ≠ 𝟬"
assumes "f∙a ≠𝟬"
assumes "(val_Zp (f∙a) > 2* val_Zp ((pderiv f)∙a))"
assumes "f∙α = 𝟬"
assumes "α ∈ carrier Zp"
assumes "val_Zp (a ⊖ α) > val_Zp ((pderiv f)∙a)"
assumes "f∙β = 𝟬"
assumes "β ∈ carrier Zp"
assumes "val_Zp (a ⊖ β) > val_Zp ((pderiv f)∙a)"
assumes "val_Zp ((pderiv f)∙α) = val_Zp ((pderiv f)∙a)"
shows "α = β"
proof-
have "α ≠ a"
using assms(4) assms(6) by auto
have "β ≠ a"
using assms(4) assms(9) by auto
have 0: "val_Zp (β ⊖ α) > val_Zp ((pderiv f)∙a)"
proof-
have "β ⊖ α = ⊖ ((a ⊖ β) ⊖ (a ⊖ α))"
by (metis R.minus_eq R.plus_diff_simp assms(10) assms(2) assms(7) minus_a_inv)
hence "val_Zp (β ⊖ α) = val_Zp ((a ⊖ β) ⊖ (a ⊖ α))"
using R.minus_closed assms(10) assms(2) assms(7) val_Zp_of_minus by presburger
thus ?thesis using val_Zp_ultrametric_diff[of "a ⊖ β" "a ⊖ α"]
by (smt R.minus_closed assms(10) assms(11) assms(2) assms(7) assms(8) min.absorb2 min_less_iff_conj)
qed
obtain h where h_def: "h = β ⊖ α"
by blast
then have h_fact: "h ∈ carrier Zp ∧ β = α ⊕ h"
by (metis R.l_neg R.minus_closed R.minus_eq R.r_zero add_assoc add_comm assms(10) assms(7))
then have 1: "f∙(α ⊕ h) = 𝟬"
using assms
by blast
obtain c where c_def: "c ∈ carrier Zp ∧ f∙(α ⊕ h) = (f ∙ α) ⊕ (deriv f α)⊗h ⊕ c ⊗(h[^](2::nat))"
using taylor_deg_1_eval'[of f α h _ "f ∙ α" "deriv f α" ]
by (meson taylor_closed assms(1) assms(7) to_fun_closed h_fact shift_closed)
then have "(f ∙ α) ⊕ (deriv f α)⊗h ⊕ c ⊗(h[^](2::nat)) = 𝟬"
by (simp add: "1")
then have 2: "(deriv f α)⊗h ⊕ c ⊗(h[^](2::nat)) = 𝟬"
by (simp add: assms(1) assms(6) assms(7) deriv_closed h_fact)
have 3: "((deriv f α) ⊕ c ⊗h)⊗h = 𝟬"
proof-
have "((deriv f α) ⊕ c ⊗h)⊗h = ((deriv f α)⊗h ⊕ (c ⊗h)⊗h)"
by (simp add: R.r_distr UP_cring.deriv_closed Zp_x_is_UP_cring assms(1) assms(7) c_def h_fact mult_comm)
then have "((deriv f α) ⊕ c ⊗h)⊗h = (deriv f α)⊗h ⊕ (c ⊗(h⊗h))"
by (simp add: mult_assoc)
then have "((deriv f α) ⊕ c ⊗h)⊗h = (deriv f α)⊗h ⊕ (c ⊗(h[^](2::nat)))"
using nat_pow_def[of Zp h "2"]
by (simp add: h_fact)
then show ?thesis
using 2
by simp
qed
have "h = 𝟬"
proof(rule ccontr)
assume "h ≠ 𝟬"
then have "(deriv f α) ⊕ c ⊗h = 𝟬"
using 2 3
by (meson R.m_closed assms(1) assms(7) c_def deriv_closed h_fact local.integral sum_closed)
then have "(deriv f α) = ⊖ c ⊗h"
by (simp add: R.l_minus R.sum_zero_eq_neg UP_cring.deriv_closed Zp_x_is_UP_cring assms(1) assms(7) c_def h_fact)
then have "val_Zp (deriv f α) = val_Zp (c ⊗ h)"
by (meson R.m_closed ‹deriv f α ⊕ c ⊗ h = 𝟬› assms(1) assms(7) c_def deriv_closed h_fact val_Zp_not_equal_imp_notequal(3))
then have P: "val_Zp (deriv f α) = val_Zp h + val_Zp c"
using val_Zp_mult c_def h_fact by force
hence "val_Zp (deriv f α) ≥ val_Zp h "
using val_pos[of c]
by (simp add: c_def)
then have "val_Zp (deriv f α) ≥ val_Zp (β ⊖ α) "
using h_def by blast
then have "val_Zp (deriv f α) > val_Zp ((pderiv f)∙a)"
using "0" by auto
then show False using pderiv_eval_deriv[of f α]
using assms(1) assms(12) assms(7) by auto
qed
then show "α = β"
using assms(10) assms(7) h_def
by auto
qed
lemma hensels_lemma':
assumes "f ∈ carrier Zp_x"
assumes "a ∈ carrier Zp"
assumes "val_Zp (f∙a) > 2*val_Zp ((pderiv f)∙a)"
shows "∃!α ∈ carrier Zp. f∙α = 𝟬 ∧ val_Zp (a ⊖ α) > val_Zp ((pderiv f)∙a)"
proof(cases "f∙a = 𝟬")
case True
have T0: "pderiv f ∙ a ≠ 𝟬"
apply(rule ccontr) using assms(3)
unfolding val_Zp_def by simp
then have T1: "a ∈ carrier Zp ∧ f∙a = 𝟬 ∧ val_Zp (a ⊖ a) > val_Zp ((pderiv f)∙a)"
using assms True
by(simp add: val_Zp_def)
have T2: "⋀b. b ∈ carrier Zp ∧ f∙b = 𝟬 ∧ val_Zp (a ⊖ b) > val_Zp ((pderiv f)∙a) ⟹ a = b"
proof- fix b assume A: "b ∈ carrier Zp ∧ f∙b = 𝟬 ∧ val_Zp (a ⊖ b) > val_Zp ((pderiv f)∙a)"
obtain h where h_def: "h = b ⊖ a"
by blast
then have h_fact: "h ∈ carrier Zp ∧ b = a ⊕ h"
by (metis A R.l_neg R.minus_closed R.minus_eq R.r_zero add_assoc add_comm assms(2))
then have 1: "f∙(a ⊕ h) = 𝟬"
using assms A by blast
obtain c where c_def: "c ∈ carrier Zp ∧ f∙(a ⊕ h) = (f ∙ a) ⊕ (deriv f a)⊗h ⊕ c ⊗(h[^](2::nat))"
using taylor_deg_1_eval'[of f a h _ "f ∙ a" "deriv f a" ]
by (meson taylor_closed assms(1) assms(2) to_fun_closed h_fact shift_closed)
then have "(f ∙ a) ⊕ (deriv f a)⊗h ⊕ c ⊗(h[^](2::nat)) = 𝟬"
by (simp add: "1")
then have 2: "(deriv f a)⊗h ⊕ c ⊗(h[^](2::nat)) = 𝟬"
by (simp add: True assms(1) assms(2) deriv_closed h_fact)
hence 3: "((deriv f a) ⊕ c ⊗h)⊗h = 𝟬"
proof-
have "((deriv f a) ⊕ c ⊗h)⊗h = ((deriv f a)⊗h ⊕ (c ⊗h)⊗h)"
by (simp add: R.l_distr assms(1) assms(2) c_def deriv_closed h_fact)
then have "((deriv f a) ⊕ c ⊗h)⊗h = (deriv f a)⊗h ⊕ (c ⊗(h⊗h))"
by (simp add: mult_assoc)
then have "((deriv f a) ⊕ c ⊗h)⊗h = (deriv f a)⊗h ⊕ (c ⊗(h[^](2::nat)))"
using nat_pow_def[of Zp h "2"]
by (simp add: h_fact)
then show ?thesis
using 2
by simp
qed
have "h = 𝟬"
proof(rule ccontr)
assume "h ≠ 𝟬"
then have "(deriv f a) ⊕ c ⊗h = 𝟬"
using 2 3
by (meson R.m_closed UP_cring.deriv_closed Zp_x_is_UP_cring assms(1) assms(2) c_def h_fact local.integral sum_closed)
then have "(deriv f a) = ⊖ c ⊗h"
using R.l_minus R.minus_equality assms(1) assms(2) c_def deriv_closed h_fact by auto
then have "val_Zp (deriv f a) = val_Zp (c ⊗ h)"
by (meson R.m_closed ‹deriv f a ⊕ c ⊗ h = 𝟬› assms(1) assms(2) c_def deriv_closed h_fact val_Zp_not_equal_imp_notequal(3))
then have P: "val_Zp (deriv f a) = val_Zp h + val_Zp c"
by (simp add: c_def h_fact val_Zp_mult)
have "val_Zp (deriv f a) ≥ val_Zp h "
using P val_pos[of c] c_def
by simp
then have "val_Zp (deriv f a) ≥ val_Zp (b ⊖ a) "
using h_def by blast
then have "val_Zp (deriv f a) > val_Zp ((pderiv f)∙a)"
by (metis (no_types, lifting) A assms(2) h_def h_fact minus_a_inv not_less order_trans val_Zp_of_minus)
then have P0:"val_Zp (deriv f a) > val_Zp (deriv f a)"
by (metis UP_cring.pderiv_eval_deriv Zp_x_is_UP_cring assms(1) assms(2))
thus False by auto
qed
then show "a = b"
by (simp add: assms(2) h_fact)
qed
show ?thesis
using T1 T2
by blast
next
case False
have F0: "pderiv f ∙ a ≠ 𝟬"
apply(rule ccontr) using assms(3)
unfolding val_Zp_def by simp
obtain α where alpha_def:
"f∙α = 𝟬" "α ∈ carrier Zp"
"val_Zp (a ⊖ α) > val_Zp ((pderiv f)∙a)"
"(val_Zp (a ⊖ α) = val_Zp (divide (f∙a) ((pderiv f)∙a)))"
"val_Zp ((pderiv f)∙α) = val_Zp ((pderiv f)∙a)"
using assms hensels_lemma F0 False by blast
have 0: "⋀x. x ∈ carrier Zp ∧ f ∙ x = 𝟬 ∧ val_Zp (a ⊖ x) > val_Zp (pderiv f ∙ a) ∧ val_Zp (pderiv f ∙ a) ≠ val_Zp (a ⊖ x) ⟹ x= α"
using alpha_def assms hensels_lemma_unique_root[of f a α] F0 False by blast
have 1: "α ∈ carrier Zp ∧ f ∙ α = 𝟬 ∧ val_Zp (a ⊖ α) > val_Zp (pderiv f ∙ a) ∧ val_Zp (pderiv f ∙ a) ≠ val_Zp (a ⊖ α)"
using alpha_def order_less_le by blast
thus ?thesis
using 0
by (metis (no_types, hide_lams) R.minus_closed alpha_def(1-3) assms(2) equal_val_Zp val_Zp_ultrametric_eq')
qed
section‹Some Applications of Hensel's Lemma to Root Finding for Polynomials over $\mathbb{Z}_p$›
lemma Zp_square_root_criterion:
assumes "p ≠ 2"
assumes "a ∈ carrier Zp"
assumes "b ∈ carrier Zp"
assumes "val_Zp b ≥ val_Zp a"
assumes "a ≠ 𝟬"
assumes "b ≠ 𝟬"
shows "∃y ∈ carrier Zp. a[^](2::nat) ⊕ 𝗉⊗b[^](2::nat) = (y [^]⇘Zp⇙ (2::nat))"
proof-
have bounds: "val_Zp a < ∞" "val_Zp a ≥ 0" "val_Zp b < ∞" "val_Zp b ≥ 0"
using assms(2) assms(3) assms(6) assms(5) val_Zp_def val_pos[of b] val_pos[of a]
by auto
obtain f where f_def: "f = monom Zp_x 𝟭 2 ⊕⇘Zp_x⇙ to_polynomial Zp (⊖ (a[^](2::nat)⊕ 𝗉⊗b[^](2::nat)))"
by simp
have "∃ α. f∙α = 𝟬 ∧ α ∈ carrier Zp"
proof-
have 0: "f ∈ carrier Zp_x"
using f_def
by (simp add: X_closed assms(2) assms(3) to_poly_closed)
have 1: "(pderiv f)∙a = [(2::nat)] ⋅ 𝟭 ⊗ a"
proof-
have "pderiv f = pderiv (monom Zp_x 𝟭 2)"
using assms f_def pderiv_add[of "monom Zp_x 𝟭 2"] to_poly_closed R.nat_pow_closed
pderiv_deg_0
unfolding to_polynomial_def
using P.nat_pow_closed P.r_zero R.add.inv_closed X_closed Zp_int_inc_closed deg_const monom_term_car pderiv_closed sum_closed
by (metis (no_types, lifting) R.one_closed monom_closed)
then have 20: "pderiv f = monom (Zp_x) ([(2::nat) ] ⋅ 𝟭) (1::nat)"
using pderiv_monom[of 𝟭 2]
by simp
have 21: "[(2::nat)] ⋅ 𝟭 ≠ 𝟬"
using Zp_char_0'[of 2] by simp
have 22: "(pderiv f)∙a = [(2::nat)] ⋅ 𝟭 ⊗ (a[^]((1::nat)))"
using 20
by (simp add: Zp_nat_inc_closed assms(2) to_fun_monom)
then show ?thesis
using assms(2)
by (simp add: cring.cring_simprules(12))
qed
have 2: "(pderiv f)∙a ≠ 𝟬"
using 1 assms
by (metis Zp_char_0' Zp_nat_inc_closed local.integral zero_less_numeral)
have 3: "f∙a = ⊖ (𝗉⊗b[^](2::nat))"
proof-
have 3: "f∙a =
monom (UP Zp) 𝟭 2 ∙ a ⊕
to_polynomial Zp (⊖ (a [^] (2::nat) ⊕ [p] ⋅ 𝟭 ⊗ b [^] (2::nat)))∙a"
unfolding f_def apply(rule to_fun_plus)
apply (simp add: assms(2) assms(3) to_poly_closed)
apply simp
by (simp add: assms(2))
have 30: "f∙a = a[^](2::nat) ⊖ (a[^](2::nat) ⊕ 𝗉⊗b[^](2::nat))"
unfolding 3 by (simp add: R.minus_eq assms(2) assms(3) to_fun_monic_monom to_fun_to_poly)
have 31: "f∙a = a[^](2::nat) ⊖ a[^](2::nat) ⊖ (𝗉⊗b[^](2::nat))"
proof-
have 310: "a[^](2::nat) ∈ carrier Zp"
using assms(2) pow_closed
by blast
have 311: "𝗉⊗(b[^](2::nat)) ∈ carrier Zp"
by (simp add: assms(3) monom_term_car)
have "⊖ (a [^] (2::nat)⊕(𝗉 ⊗ b [^] (2::nat))) = ⊖ (a [^] (2::nat)) ⊕ ⊖ (𝗉 ⊗ (b [^] (2::nat)))"
using 310 311 R.minus_add by blast
then show ?thesis
by (simp add: "30" R.minus_eq add_assoc)
qed
have 32: "f∙a = (a[^](2::nat) ⊖ a[^](2::nat)) ⊖ (𝗉⊗b[^](2::nat))"
using 31 unfolding a_minus_def
by blast
have 33: "𝗉⊗b[^](2::nat) ∈ carrier Zp"
by (simp add: Zp_nat_inc_closed assms(3) monom_term_car)
have 34: "a[^](2::nat) ∈ carrier Zp"
using assms(2) pow_closed by blast
then have 34: "(a[^](2::nat) ⊖ a[^](2::nat)) = 𝟬 "
by simp
have 35: "f∙a = 𝟬 ⊖ (𝗉⊗b[^](2::nat))"
by (simp add: "32" "34")
then show ?thesis
using 33 unfolding a_minus_def
by (simp add: cring.cring_simprules(3))
qed
have 4: "f∙a ≠𝟬"
using 3 assms
by (metis R.add.inv_eq_1_iff R.m_closed R.nat_pow_closed Zp.integral Zp_int_inc_closed
mult_zero_r nonzero_pow_nonzero p_natpow_prod_Suc(1) p_pow_nonzero(2))
have 5: "val_Zp (f∙a) = 1 + 2*val_Zp b"
proof-
have "val_Zp (f∙a) = val_Zp (𝗉⊗b[^](2::nat))"
using 3 Zp_int_inc_closed assms(3) monom_term_car val_Zp_of_minus by presburger
then have "val_Zp (𝗉⊗b[^](2::nat)) = 1 + val_Zp (b[^](2::nat))"
by (simp add: assms(3) val_Zp_mult val_Zp_p)
then show ?thesis
using assms(3) assms(6)
using Zp_def ‹val_Zp (to_fun f a) = val_Zp ([p] ⋅ 𝟭 ⊗ b [^] 2)› not_nonzero_Zp
padic_integers_axioms val_Zp_pow' by fastforce
qed
have 6: "val_Zp ((pderiv f)∙a) = val_Zp a"
proof-
have 60: "val_Zp ([(2::nat)] ⋅ 𝟭 ⊗ a) = val_Zp ([(2::nat)] ⋅ 𝟭) + val_Zp a"
by (simp add: Zp_char_0' assms(2) assms(5) val_Zp_mult ord_of_nonzero(2) ord_pos)
have "val_Zp ([(2::nat)] ⋅ 𝟭) = 0"
proof-
have "(2::nat) < p"
using prime assms prime_ge_2_int by auto
then have "(2::nat) mod p = (2::nat)"
by simp
then show ?thesis
by (simp add: val_Zp_p_nat_unit)
qed
then show ?thesis
by (simp add: "1" "60")
qed
then have 7: "val_Zp (f∙a) > 2* val_Zp ((pderiv f)∙a)"
using bounds 5 assms(4)
by (simp add: assms(5) assms(6) one_eint_def val_Zp_def)
obtain α where
A0: "f∙α = 𝟬" "α ∈ carrier Zp"
using hensels_lemma[of f a] "0" "2" "4" "7" assms(2)
by blast
show ?thesis
using A0 by blast
qed
then obtain α where α_def: "f∙α = 𝟬 ∧ α ∈ carrier Zp"
by blast
have "f∙α = α [^](2::nat) ⊖ (a[^](2::nat)⊕ 𝗉⊗b[^](2::nat))"
proof-
have 0: "f∙α =
monom (UP Zp) 𝟭 2 ∙ α ⊕
to_polynomial Zp (⊖ (a [^] (2::nat) ⊕ [p] ⋅ 𝟭 ⊗ b [^] (2::nat)))∙α"
unfolding f_def apply(rule to_fun_plus)
apply (simp add: assms(2) assms(3) to_poly_closed)
apply simp
by (simp add: α_def)
thus ?thesis
by (simp add: R.minus_eq α_def assms(2) assms(3) to_fun_monic_monom to_fun_to_poly)
qed
then show ?thesis
by (metis R.r_right_minus_eq Zp_int_inc_closed α_def assms(2) assms(3) monom_term_car pow_closed sum_closed)
qed
lemma Zp_semialg_eq:
assumes "a ∈ nonzero Zp"
shows "∃y ∈ carrier Zp. 𝟭 ⊕ (𝗉 [^] (3::nat))⊗ (a [^] (4::nat)) = (y [^] (2::nat))"
proof-
obtain f where f_def: "f = monom Zp_x 𝟭 2 ⊕⇘Zp_x⇙ to_poly (⊖ (𝟭 ⊕ (𝗉 [^] (3::nat))⊗ (a [^] (4::nat))))"
by simp
have a_car: "a ∈ carrier Zp"
by (simp add: nonzero_memE assms)
have "f ∈ carrier Zp_x"
using f_def
by (simp add: a_car to_poly_closed)
hence 0:"f∙𝟭 = 𝟭 ⊖ (𝟭 ⊕ (𝗉 [^] (3::nat))⊗ (a [^] (4::nat)))"
using f_def
by (simp add: R.minus_eq assms nat_pow_nonzero nonzero_mult_in_car p_pow_nonzero' to_fun_monom_plus to_fun_to_poly to_poly_closed)
then have 1: "f∙𝟭 = ⊖ (𝗉 [^] (3::nat))⊗ (a [^] (4::nat))"
unfolding a_minus_def
by (smt R.add.inv_closed R.l_minus R.minus_add R.minus_minus R.nat_pow_closed R.one_closed R.r_neg1 a_car monom_term_car p_pow_nonzero(1))
then have "val_Zp (f∙𝟭) = 3 + val_Zp (a [^] (4::nat))"
using assms val_Zp_mult[of "𝗉 [^] (3::nat)" "(a [^] (4::nat))" ]
val_Zp_p_pow p_pow_nonzero[of "3::nat"] val_Zp_of_minus
by (metis R.l_minus R.nat_pow_closed a_car monom_term_car of_nat_numeral)
then have 2: "val_Zp (f∙𝟭) = 3 + 4* val_Zp a"
using assms val_Zp_pow' by auto
have "pderiv f = pderiv (monom Zp_x 𝟭 2)"
using assms f_def pderiv_add[of "monom Zp_x 𝟭 2"] to_poly_closed R.nat_pow_closed pderiv_deg_0
unfolding to_polynomial_def
by (metis (no_types, lifting) P.r_zero R.add.inv_closed R.add.m_closed R.one_closed
UP_zero_closed a_car deg_const deg_nzero_nzero monom_closed monom_term_car p_pow_nonzero(1))
then have 3: "pderiv f = [(2::nat)] ⋅ 𝟭 ⊙⇘Zp_x⇙ X "
by (metis P.nat_pow_eone R.one_closed Suc_1 X_closed diff_Suc_1 monom_rep_X_pow pderiv_monom')
hence 4: "val_Zp ((pderiv f)∙𝟭) = val_Zp ([(2::nat)] ⋅ 𝟭 )"
by (metis R.add.nat_pow_eone R.nat_inc_prod R.nat_inc_prod' R.nat_pow_one R.one_closed
Zp_nat_inc_closed ‹pderiv f = pderiv (monom Zp_x 𝟭 2)› pderiv_monom to_fun_monom)
have "(2::int) = (int (2::nat))"
by simp
then have 5: "[(2::nat)] ⋅ 𝟭 = ([(int (2::nat))] ⋅ 𝟭 )"
using add_pow_def int_pow_int
by metis
have 6: "val_Zp ((pderiv f)∙𝟭) ≤ 1"
apply(cases "p = 2")
using "4" "5" val_Zp_p apply auto[1]
proof-
assume "p ≠ 2"
then have 60: "coprime 2 p"
using prime prime_int_numeral_eq primes_coprime two_is_prime_nat by blast
have 61: "2 < p"
using 60 prime
by (smt ‹p ≠ 2› prime_gt_1_int)
then show ?thesis
by (smt "4" "5" ‹2 = int 2› mod_pos_pos_trivial nonzero_closed p_nonzero val_Zp_p val_Zp_p_int_unit val_pos)
qed
have 7: "val_Zp (f∙𝟭) ≥ 3"
proof-
have "eint 4 * val_Zp a ≥ 0"
using 2 val_pos[of a]
by (metis R.nat_pow_closed a_car assms of_nat_numeral val_Zp_pow' val_pos)
thus ?thesis
using "2" by auto
qed
have "2*val_Zp ((pderiv f)∙𝟭) ≤ 2*1"
using 6 one_eint_def eint_mult_mono'
by (smt ‹2 = int 2› eint.distinct(2) eint_ile eint_ord_simps(1) eint_ord_simps(2) mult.commute
ord_Zp_p ord_Zp_p_pow ord_Zp_pow p_nonzero p_pow_nonzero(1) times_eint_simps(1) val_Zp_p val_Zp_pow' val_pos)
hence 8: "2 * val_Zp ((pderiv f)∙ 𝟭) < val_Zp (f∙𝟭)"
using 7 le_less_trans[of "2 * val_Zp ((pderiv f)∙ 𝟭)" "2::eint" 3]
less_le_trans[of "2 * val_Zp ((pderiv f)∙ 𝟭)" 3 "val_Zp (f∙𝟭)"] one_eint_def
by auto
obtain α where α_def: "f∙α = 𝟬" and α_def' :"α ∈ carrier Zp"
using 2 6 7 hensels_lemma' 8 ‹f ∈ carrier Zp_x› by blast
have 0: "(monom Zp_x 𝟭 2) ∙ α = α [^] (2::nat)"
by (simp add: α_def' to_fun_monic_monom)
have 1: "to_poly (⊖ (𝟭 ⊕ (𝗉 [^] (3::nat))⊗ (a [^] (4::nat)))) ∙ α =⊖( 𝟭 ⊕ (𝗉 [^] (3::nat))⊗ (a [^] (4::nat)))"
by (simp add: α_def' a_car to_fun_to_poly)
then have "α [^] (2::nat) ⊖ (𝟭 ⊕ (𝗉 [^] (3::nat))⊗ (a [^] (4::nat))) = 𝟬"
using α_def α_def'
by (simp add: R.minus_eq a_car f_def to_fun_monom_plus to_poly_closed)
then show ?thesis
by (metis R.add.m_closed R.nat_pow_closed R.one_closed R.r_right_minus_eq α_def' a_car monom_term_car p_pow_nonzero(1))
qed
lemma Zp_nth_root_lemma:
assumes "a ∈ carrier Zp"
assumes "a ≠ 𝟭"
assumes "n > 1"
assumes "val_Zp (𝟭 ⊖ a) > 2*val_Zp ([(n::nat)]⋅ 𝟭)"
shows "∃ b ∈ carrier Zp. b[^]n = a"
proof-
obtain f where f_def: "f = monom Zp_x 𝟭 n ⊕⇘Zp_x⇙ monom Zp_x (⊖a) 0"
by simp
have "f ∈ carrier Zp_x"
using f_def monom_closed assms
by simp
have 0: "pderiv f = monom Zp_x ([n]⋅ 𝟭) (n-1)"
by (simp add: assms(1) f_def pderiv_add pderiv_monom)
have 1: "f ∙ 𝟭 = 𝟭 ⊖ a"
using f_def
by (metis R.add.inv_closed R.minus_eq R.nat_pow_one R.one_closed assms(1) to_fun_const to_fun_monom to_fun_monom_plus monom_closed)
have 2: "(pderiv f) ∙ 𝟭 = ([n]⋅ 𝟭)"
using 0 to_fun_monom assms
by simp
have 3: "val_Zp (f ∙ 𝟭) > 2* val_Zp ((pderiv f) ∙ 𝟭)"
using 1 2 assms
by (simp add: val_Zp_def)
have 4: "f ∙ 𝟭 ≠ 𝟬"
using 1 assms(1) assms(2) by auto
have 5: "(pderiv f) ∙ 𝟭 ≠ 𝟬"
using "2" Zp_char_0' assms(3) by auto
obtain β where beta_def: "β ∈ carrier Zp ∧ f ∙ β = 𝟬"
using hensels_lemma[of f 𝟭]
by (metis "3" "5" R.one_closed ‹f ∈ carrier Zp_x›)
then have "(β [^] n) ⊖ a = 𝟬"
using f_def R.add.inv_closed assms(1) to_fun_const[of "⊖ a"] to_fun_monic_monom[of β n] to_fun_plus monom_closed
unfolding a_minus_def
by (simp add: beta_def)
then have "β ∈ carrier Zp ∧ β [^] n = a"
using beta_def nonzero_memE not_eq_diff_nonzero assms(1) pow_closed
by blast
then show ?thesis by blast
qed
end
end
Theory Zp_Compact
theory Zp_Compact
imports Padic_Int_Topology
begin
context padic_integers
begin
lemma res_ring_car:
"carrier (Zp_res_ring k) = {0..p ^ k - 1}"
unfolding residue_ring_def by simp
text‹The refinement of a sequence by a function $nat \Rightarrow nat$›
definition take_subseq :: "(nat ⇒ 'a) ⇒ (nat ⇒ nat) ⇒ (nat ⇒ 'a)" where
"take_subseq s f = (λk. s (f k))"
text‹Predicate for increasing function on the natural numbers›
definition is_increasing :: "(nat ⇒ nat) ⇒ bool" where
"is_increasing f = (∀ n m::nat. n>m ⟶ (f n) > (f m))"
text‹Elimination and introduction lemma for increasing functions›
lemma is_increasingI:
assumes "⋀ n m::nat. n>m ⟹ (f n) > (f m)"
shows "is_increasing f"
unfolding is_increasing_def
using assms
by blast
lemma is_increasingE:
assumes "is_increasing f"
assumes " n> m"
shows "f n > f m"
using assms
unfolding is_increasing_def
by blast
text‹The subsequence predicate›
definition is_subseq_of :: "(nat ⇒ 'a) ⇒ (nat ⇒ 'a) ⇒ bool" where
"is_subseq_of s s' = (∃(f::nat ⇒ nat). is_increasing f ∧ s' = take_subseq s f)"
text‹Subsequence introduction lemma›
lemma is_subseqI:
assumes "is_increasing f"
assumes "s' = take_subseq s f"
shows "is_subseq_of s s'"
using assms
unfolding is_subseq_of_def
by auto
lemma is_subseq_ind:
assumes "is_subseq_of s s'"
shows "∃ l. s' k = s l"
using assms
unfolding is_subseq_of_def take_subseq_def by blast
lemma is_subseq_closed:
assumes "s ∈ closed_seqs Zp"
assumes "is_subseq_of s s'"
shows "s' ∈ closed_seqs Zp"
apply(rule closed_seqs_memI)
using is_subseq_ind assms closed_seqs_memE
by metis
text‹Given a sequence and a predicate, returns the function from nat to nat which represents
the increasing sequences of indices n on which P (s n) holds.›
primrec seq_filter :: "(nat ⇒'a) ⇒ ('a ⇒ bool) ⇒ nat ⇒ nat" where
"seq_filter s P (0::nat) = (LEAST k::nat. P (s k))"|
"seq_filter s P (Suc n) = (LEAST k:: nat. (P (s k)) ∧ k > (seq_filter s P n))"
lemma seq_filter_pre_increasing:
assumes "∀n::nat. ∃m. m > n ∧ P (s m)"
shows "seq_filter s P n < seq_filter s P (Suc n)"
apply(auto)
proof(induction n)
case 0
have "∃k. P (s k)" using assms(1) by blast
then have "∃k::nat. (LEAST k::nat. (P (s k))) ≥ 0"
by blast
obtain k where "(LEAST k::nat. (P (s k))) = k" by simp
have "∃l. l = (LEAST l::nat. (P (s l) ∧ l > k))"
by simp
thus ?case
by (metis (no_types, lifting) LeastI assms)
next
case (Suc n)
then show ?case
by (metis (no_types, lifting) LeastI assms)
qed
lemma seq_filter_increasing:
assumes "∀n::nat. ∃m. m > n ∧ P (s m)"
shows "is_increasing (seq_filter s P)"
by (metis assms seq_filter_pre_increasing is_increasingI lift_Suc_mono_less)
definition filtered_seq :: "(nat ⇒ 'a) ⇒ ('a ⇒ bool) ⇒ (nat ⇒ 'a)" where
"filtered_seq s P = take_subseq s (seq_filter s P)"
lemma filter_exist:
assumes "s ∈ closed_seqs Zp"
assumes "∀n::nat. ∃m. m > n ∧ P (s m)"
shows "⋀m. n≤m ⟹ P (s (seq_filter s P n))"
proof(induct n)
case 0
then show ?case
using LeastI assms(2) by force
next
case (Suc n)
then show ?case
by (smt LeastI assms(2) seq_filter.simps(2))
qed
text‹In a filtered sequence, every element satisfies the filtering predicate ›
lemma fil_seq_pred:
assumes "s ∈ closed_seqs Zp"
assumes "s' = filtered_seq s P"
assumes "∀n::nat. ∃m. m > n ∧ P (s m)"
shows "⋀m::nat. P (s' m)"
proof-
have "∃k. P (s k)" using assms(3)
by blast
fix m
obtain k where kdef: "k = seq_filter s P m" by auto
have "∃k. P (s k)"
using assms(3) by auto
then have "P (s k)"
by (metis (full_types) assms(1) assms(3) kdef le_refl less_imp_triv not_less_eq filter_exist )
then have "s' m = s k"
by (simp add: assms(2) filtered_seq_def kdef take_subseq_def)
hence "P (s' m)"
by (simp add: ‹P (s k)›)
thus "⋀m. P (s' m)" using assms(2) assms(3) dual_order.strict_trans filter_exist filtered_seq_def
lessI less_Suc_eq_le take_subseq_def
by (metis (mono_tags, hide_lams) assms(1))
qed
definition kth_res_equals :: "nat ⇒ int ⇒ (padic_int ⇒ bool)" where
"kth_res_equals k n a = (a k = n)"
definition indicator:: "(nat ⇒ 'a) ⇒ ('a ⇒ bool)" where
"indicator s a = (∃n::nat. s n = a)"
text‹Choice function for a subsequence with constant kth residue. Could be made constructive by
choosing the LEAST n if we wanted.›
definition const_res_subseq :: "nat ⇒ padic_int_seq ⇒ padic_int_seq" where
"const_res_subseq k s = (SOME s'::(padic_int_seq). (∃ n. is_subseq_of s s' ∧ s'
= (filtered_seq s (kth_res_equals k n)) ∧ (∀m. s' m k = n)))"
text‹The constant kth residue value for the sequence obtained by the previous function›
definition const_res :: "nat ⇒ padic_int_seq ⇒ int" where
"const_res k s = (THE n. (∀ m. (const_res_subseq k s) m k = n))"
definition maps_to_n:: "int ⇒ (nat ⇒ int) ⇒ bool" where
"maps_to_n n f = (∀(k::nat). f k ∈ {0..n})"
definition drop_res :: "int ⇒ (nat ⇒ int) ⇒ (nat ⇒ int)" where
"drop_res k f n = (if (f n) = k then 0 else f n)"
lemma maps_to_nE:
assumes "maps_to_n n f"
shows "(f k) ∈ {0..n}"
using assms
unfolding maps_to_n_def
by blast
lemma maps_to_nI:
assumes "⋀n. f n ∈{0 .. k}"
shows "maps_to_n k f"
using assms maps_to_n_def by auto
lemma maps_to_n_drop_res:
assumes "maps_to_n (Suc n) f"
shows "maps_to_n n (drop_res (Suc n) f)"
proof-
fix k
have "drop_res (Suc n) f k ∈ {0..n}"
proof(cases "f k = Suc n")
case True
then have "drop_res (Suc n) f k = 0"
unfolding drop_res_def by auto
then show ?thesis
using assms local.drop_res_def maps_to_n_def by auto
next
case False
then show ?thesis
using assms atLeast0_atMost_Suc maps_to_n_def drop_res_def
by auto
qed
then have "⋀k. drop_res (Suc n) f k ∈ {0..n}"
using assms local.drop_res_def maps_to_n_def by auto
then show "maps_to_n n (drop_res (Suc n) f)" using maps_to_nI
using maps_to_n_def by blast
qed
lemma drop_res_eq_f:
assumes "maps_to_n (Suc n) f"
assumes "¬ (∀m. ∃n. n>m ∧ (f n = (Suc k)))"
shows "∃N. ∀n. n>N ⟶ f n = drop_res (Suc k) f n"
proof-
have "∃m. ∀n. n ≤ m ∨ (f n) ≠ (Suc k)"
using assms
by (meson Suc_le_eq nat_le_linear)
then have "∃m. ∀n. n ≤ m ∨ (f n) = drop_res (Suc k) f n"
using drop_res_def by auto
then show ?thesis
by (meson less_Suc_eq_le order.asym)
qed
lemma maps_to_n_infinite_seq:
shows "⋀f. maps_to_n (k::nat) f ⟹ ∃l::int. ∀m. ∃n. n>m ∧ (f n = l)"
proof(induction k)
case 0
then have "⋀n. f n ∈ {0}"
using maps_to_nE[of 0 f] by auto
then show " ∃l. ∀m. ∃n. m < n ∧ f n = l"
by blast
next
case (Suc k)
assume IH: "⋀f. maps_to_n k f ⟹ ∃l. ∀m. ∃n. m < n ∧ f n = l"
fix f
assume A: "maps_to_n (Suc k) f"
show "∃l. ∀m. ∃n. n>m ∧ (f n = l)"
proof(cases " ∀m. ∃n. n>m ∧ (f n = (Suc k))")
case True
then show ?thesis by blast
next
case False
then obtain N where N_def: "∀n. n>N ⟶ f n = drop_res (Suc k) f n"
using drop_res_eq_f drop_res_def
by fastforce
have " maps_to_n k (drop_res (Suc k) f) "
using A maps_to_n_drop_res by blast
then have " ∃l. ∀m. ∃n. m < n ∧ (drop_res (Suc k) f) n = l"
using IH by blast
then obtain l where l_def: "∀m. ∃n. m < n ∧ (drop_res (Suc k) f) n = l"
by blast
have "∀m. ∃n. n>m ∧ (f n = l)"
apply auto
proof-
fix m
show "∃n>m. f n = l"
proof-
obtain n where N'_def: "(max m N) < n ∧ (drop_res (Suc k) f) n = l"
using l_def by blast
have "f n = (drop_res (Suc k) f) n"
using N'_def N_def
by simp
then show ?thesis
using N'_def by auto
qed
qed
then show ?thesis
by blast
qed
qed
lemma int_nat_p_pow_minus:
"int (nat (p ^ k - 1)) = p ^ k - 1"
by (simp add: prime prime_gt_0_int)
lemma maps_to_n_infinite_seq_res_ring:
"⋀f. f ∈ (UNIV::nat set) → carrier (Zp_res_ring k) ⟹ ∃l. ∀m. ∃n. n>m ∧ (f n = l)"
apply(rule maps_to_n_infinite_seq[of "nat (p^k - 1)"])
unfolding maps_to_n_def res_ring_car int_nat_p_pow_minus by blast
definition index_to_residue :: "padic_int_seq ⇒ nat ⇒ nat ⇒ int" where
"index_to_residue s k m = ((s m) k)"
lemma seq_maps_to_n:
assumes "s ∈ closed_seqs Zp"
shows "(index_to_residue s k) ∈ UNIV → carrier (Zp_res_ring k)"
proof-
have A1: "⋀m. (s m) ∈ carrier Zp"
using assms closed_seqs_memE by auto
have A2: "⋀m. (s m k) ∈ carrier (Zp_res_ring k)"
using assms by (simp add: A1)
have "⋀m. index_to_residue s k m = s m k"
using index_to_residue_def
by auto
thus "index_to_residue s k ∈ UNIV → carrier (residue_ring (p ^ k))"
using A2 by simp
qed
lemma seq_pr_inc:
assumes "s ∈ closed_seqs Zp"
shows "∃l. ∀m. ∃n > m. (kth_res_equals k l) (s n)"
proof-
fix k l m
have 0: "(kth_res_equals k l) (s m) ⟹ (s m) k = l"
by (simp add: kth_res_equals_def)
have 1: "⋀k m. s m k = index_to_residue s k m"
by (simp add: index_to_residue_def)
have 2: "(index_to_residue s k) ∈ UNIV → carrier (Zp_res_ring k)"
using seq_maps_to_n assms by blast
have 3: "⋀m. s m k ∈ carrier (Zp_res_ring k)"
proof-
fix m have 30: "s m k = index_to_residue s k m"
using 1 by blast
show " s m k ∈ carrier (Zp_res_ring k)"
unfolding 30 using 2 by blast
qed
obtain j where j_def: "j = nat (p^k - 1)"
by blast
have j_to_int: "int j = p^k - 1"
using j_def
by (simp add: prime prime_gt_0_int)
have "∃l. ∀m. ∃n. n > m ∧ (index_to_residue s k n = l)"
by(rule maps_to_n_infinite_seq_res_ring[of _ k], rule seq_maps_to_n, rule assms)
hence "∃l. ∀m. ∃n. n > m ∧ (s n k = l)"
by (simp add: index_to_residue_def)
thus "∃l. ∀m. ∃n > m. (kth_res_equals k l) (s n)"
using kth_res_equals_def by auto
qed
lemma kth_res_equals_subseq:
assumes "s ∈ closed_seqs Zp"
shows "∃n. is_subseq_of s (filtered_seq s (kth_res_equals k n)) ∧ (∀m. (filtered_seq s (kth_res_equals k n)) m k = n)"
proof-
obtain l where l_def: " ∀ m. ∃n > m. (kth_res_equals k l) (s n)"
using assms seq_pr_inc by blast
have 0: "is_subseq_of s (filtered_seq s (kth_res_equals k l))"
unfolding filtered_seq_def
apply(rule is_subseqI[of "seq_filter s (kth_res_equals k l)"])
apply(rule seq_filter_increasing, rule l_def)
by blast
have 1: " (∀m. (filtered_seq s (kth_res_equals k l)) m k = l)"
using l_def
by (meson assms kth_res_equals_def fil_seq_pred padic_integers_axioms)
show ?thesis using 0 1 by blast
qed
lemma const_res_subseq_prop_0:
assumes "s ∈ closed_seqs Zp"
shows "∃l. (((const_res_subseq k s) = filtered_seq s (kth_res_equals k l)) ∧ (is_subseq_of s (const_res_subseq k s)) ∧ (∀m.(const_res_subseq k s) m k = l))"
proof-
have " ∃n. (is_subseq_of s (filtered_seq s (kth_res_equals k n)) ∧ (∀m. (filtered_seq s (kth_res_equals k n)) m k = n))"
by (simp add: kth_res_equals_subseq assms)
then have "∃s'. (∃n. (is_subseq_of s s') ∧ (s' = filtered_seq s (kth_res_equals k n)) ∧ (∀m. s' m k = n))"
by blast
then show ?thesis
using const_res_subseq_def[of k s] const_res_subseq_def someI_ex
by (smt const_res_subseq_def someI_ex)
qed
lemma const_res_subseq_prop_1:
assumes "s ∈ closed_seqs Zp"
shows "(∀m.(const_res_subseq k s) m k = (const_res k s) )"
using const_res_subseq_prop_0[of s] const_res_def[of k s]
by (smt assms const_res_subseq_def const_res_def the_equality)
lemma const_res_subseq:
assumes "s ∈ closed_seqs Zp"
shows "is_subseq_of s (const_res_subseq k s)"
using assms const_res_subseq_prop_0[of s k] by blast
lemma const_res_range:
assumes "s ∈ closed_seqs Zp"
assumes "k > 0"
shows "const_res k s ∈ carrier (Zp_res_ring k)"
proof-
have 0: "(const_res_subseq k s) 0 ∈ carrier Zp"
using const_res_subseq[of s k] is_subseq_closed[of s "const_res_subseq k s"]
assms(1) closed_seqs_memE by blast
have 1: "(const_res_subseq k s) 0 k ∈ carrier (Zp_res_ring k)"
using 0 by simp
then show ?thesis
using assms const_res_subseq_prop_1[of s k]
by (simp add: ‹s ∈ closed_seqs Zp›)
qed
fun res_seq ::"padic_int_seq ⇒ nat ⇒ padic_int_seq" where
"res_seq s 0 = s"|
"res_seq s (Suc k) = const_res_subseq (Suc k) (res_seq s k)"
lemma res_seq_res:
assumes "s ∈ closed_seqs Zp"
shows "(res_seq s k) ∈ closed_seqs Zp"
apply(induction k)
apply (simp add: assms)
by (simp add: const_res_subseq is_subseq_closed)
lemma res_seq_res':
assumes "s ∈ closed_seqs Zp"
shows "⋀n. res_seq s (Suc k) n (Suc k) = const_res (Suc k) (res_seq s k)"
using assms res_seq_res[of s k] const_res_subseq_prop_1[of "(res_seq s k)" "Suc k" ]
by simp
lemma res_seq_subseq:
assumes "s ∈ closed_seqs Zp"
shows "is_subseq_of (res_seq s k) (res_seq s (Suc k))"
by (metis assms const_res_subseq_prop_0 res_seq_res
res_seq.simps(2))
lemma is_increasing_id:
"is_increasing (λ n. n)"
by (simp add: is_increasingI)
lemma is_increasing_comp:
assumes "is_increasing f"
assumes "is_increasing g"
shows "is_increasing (f ∘ g)"
using assms(1) assms(2) is_increasing_def
by auto
lemma is_increasing_imp_geq_id[simp]:
assumes "is_increasing f"
shows "f n ≥n"
apply(induction n)
apply simp
by (metis (mono_tags, lifting) assms is_increasing_def
leD lessI not_less_eq_eq order_less_le_subst2)
lemma is_subseq_ofE:
assumes "s ∈ closed_seqs Zp"
assumes "is_subseq_of s s'"
shows "∃k. k ≥ n ∧ s' n = s k"
proof-
obtain f where "is_increasing f ∧ s' = take_subseq s f"
using assms(2) is_subseq_of_def by blast
then have " f n ≥ n ∧ s' n = s (f n)"
unfolding take_subseq_def
by simp
then show ?thesis by blast
qed
lemma is_subseq_of_id:
assumes "s ∈ closed_seqs Zp"
shows "is_subseq_of s s"
proof-
have "s = take_subseq s (λn. n)"
unfolding take_subseq_def
by auto
then show ?thesis using is_increasing_id
using is_subseqI
by blast
qed
lemma is_subseq_of_trans:
assumes "s ∈ closed_seqs Zp"
assumes "is_subseq_of s s'"
assumes "is_subseq_of s' s''"
shows "is_subseq_of s s''"
proof-
obtain f where f_def: "is_increasing f ∧ s' = take_subseq s f"
using assms(2) is_subseq_of_def
by blast
obtain g where g_def: "is_increasing g ∧ s'' = take_subseq s' g"
using assms(3) is_subseq_of_def
by blast
have "s'' = take_subseq s (f ∘ g)"
proof
fix x
show "s'' x = take_subseq s (f ∘ g) x"
using f_def g_def unfolding take_subseq_def
by auto
qed
then show ?thesis
using f_def g_def is_increasing_comp is_subseq_of_def
by blast
qed
lemma res_seq_subseq':
assumes "s ∈ closed_seqs Zp"
shows "is_subseq_of s (res_seq s k)"
proof(induction k)
case 0
then show ?case using is_subseq_of_id
by (simp add: assms)
next
case (Suc k)
fix k
assume "is_subseq_of s (res_seq s k)"
then show "is_subseq_of s (res_seq s (Suc k)) "
using assms is_subseq_of_trans res_seq_subseq
by blast
qed
lemma res_seq_subseq'':
assumes "s ∈ closed_seqs Zp"
shows "is_subseq_of (res_seq s n) (res_seq s (n + k))"
apply(induction k)
apply (simp add: assms is_subseq_of_id res_seq_res)
using add_Suc_right assms is_subseq_of_trans res_seq_res res_seq_subseq by presburger
definition acc_point :: "padic_int_seq ⇒ padic_int" where
"acc_point s k = (if (k = 0) then (0::int) else ((res_seq s k) 0 k))"
lemma res_seq_res_1:
assumes "s ∈ closed_seqs Zp"
shows "res_seq s (Suc k) 0 k = res_seq s k 0 k"
proof-
obtain n where n_def: "res_seq s (Suc k) 0 = res_seq s k n"
by (metis assms is_subseq_of_def res_seq_subseq take_subseq_def)
have "res_seq s (Suc k) 0 k = res_seq s k n k"
using n_def by auto
thus ?thesis
using assms padic_integers.p_res_ring_0'
padic_integers_axioms res_seq.elims residues_closed
proof -
have "∀n. s n ∈ carrier Zp"
by (simp add: assms closed_seqs_memE)
then show ?thesis
by (metis ‹res_seq s (Suc k) 0 k = res_seq s k n k› assms padic_integers.p_res_ring_0' padic_integers_axioms res_seq.elims res_seq_res' residues_closed)
qed
qed
lemma acc_point_cres:
assumes "s ∈ closed_seqs Zp"
shows "(acc_point s (Suc k)) = (const_res (Suc k) (res_seq s k))"
proof-
have "Suc k > 0" by simp
have "(res_seq s (Suc k)) = const_res_subseq (Suc k) (res_seq s k)"
by simp
then have "(const_res_subseq (Suc k) (res_seq s k)) 0 (Suc k) = const_res (Suc k) (res_seq s k)"
using assms res_seq_res' padic_integers_axioms by auto
have "acc_point s (Suc k) = res_seq s (Suc k) 0 (Suc k)" using acc_point_def by simp
then have "acc_point s (Suc k) = (const_res_subseq (Suc k) (res_seq s k)) 0 (Suc k)"
by simp
thus ?thesis
by (simp add: ‹(const_res_subseq (Suc k) (res_seq s k)) 0 (Suc k) = const_res (Suc k) (res_seq s k)›)
qed
lemma acc_point_res:
assumes "s ∈ closed_seqs Zp"
shows "residue (p ^ k) (acc_point s (Suc k)) = acc_point s k"
proof(cases "k = 0")
case True
then show ?thesis
by (simp add: acc_point_def residue_1_zero)
next
case False
assume "k ≠ 0" show "residue (p ^ k) (acc_point s (Suc k)) = acc_point s k"
using False acc_point_def assms lessI less_imp_le nat.distinct(1) res_seq_res_1 res_seq_res
Zp_defs(3) closed_seqs_memE prime by (metis padic_set_res_coherent)
qed
lemma acc_point_closed:
assumes "s ∈ closed_seqs Zp"
shows "acc_point s ∈ carrier Zp"
proof-
have "acc_point s ∈ padic_set p"
proof(rule padic_set_memI)
show "⋀m. acc_point s m ∈ carrier (residue_ring (p ^ m))"
proof-
fix m
show "acc_point s m ∈ carrier (residue_ring (p ^ m))"
proof(cases "m = 0")
case True
then show ?thesis
by (simp add: acc_point_def residue_ring_def)
next
case False
assume "m ≠ 0"
then have "acc_point s m = res_seq s m 0 m"
by (simp add: acc_point_def)
then show ?thesis using const_res_range[of "(const_res_subseq (m-1) s)" m] acc_point_def[of s m]
by (metis False Suc_pred acc_point_cres assms const_res_range neq0_conv res_seq_res)
qed
qed
show "⋀m n. m < n ⟹ residue (p ^ m) (acc_point s n) = acc_point s m"
proof-
fix m n::nat
assume A: "m < n"
show "residue (p ^ m) (acc_point s n) = acc_point s m"
proof-
obtain l where l_def: "l = n - m - 1"
by simp
have "residue (p ^ m) (acc_point s (Suc (m + l))) = acc_point s m"
proof(induction l)
case 0
then show ?case
by (simp add: acc_point_res assms)
next
case (Suc l)
then show ?case
using Zp_defs(3) acc_point_def add_Suc_right assms le_add1 closed_seqs_memE nat.distinct(1)
padic_integers.prime padic_integers_axioms res_seq_res res_seq_res_1
by (metis padic_set_res_coherent)
qed
then show ?thesis
by (metis A Suc_diff_Suc Suc_eq_plus1 add_Suc_right add_diff_inverse_nat diff_diff_left
l_def le_less_trans less_not_refl order_less_imp_le)
qed
qed
qed
then show ?thesis
by (simp add: Zp_defs(3))
qed
text‹Choice function for a subsequence of s which converges to a, if it exists›
fun convergent_subseq_fun :: "padic_int_seq ⇒ padic_int ⇒ (nat ⇒ nat)" where
"convergent_subseq_fun s a 0 = 0"|
"convergent_subseq_fun s a (Suc n) = (SOME k. k > (convergent_subseq_fun s a n)
∧ (s k (Suc n)) = a (Suc n))"
definition convergent_subseq :: "padic_int_seq ⇒ padic_int_seq" where
"convergent_subseq s = take_subseq s (convergent_subseq_fun s (acc_point s))"
lemma increasing_conv_induction_0_pre:
assumes "s ∈ closed_seqs Zp"
assumes "a = acc_point s"
shows "∃k > convergent_subseq_fun s a n. (s k (Suc n)) = a (Suc n)"
proof-
obtain l::nat where "l > 0 " by blast
have "is_subseq_of s (res_seq s (Suc n))"
using assms(1) res_seq_subseq' by blast
then obtain m where "s m = res_seq s (Suc n) l ∧ m ≥ l"
by (metis is_increasing_imp_geq_id is_subseq_of_def take_subseq_def )
have "a (Suc n) = res_seq s (Suc n) 0 (Suc n)"
by (simp add: acc_point_def assms(2))
have "s m (Suc n) = a (Suc n)"
by (metis ‹a (Suc n) = res_seq s (Suc n) 0 (Suc n)› ‹s m = res_seq s (Suc n) l ∧ l ≤ m› assms(1) res_seq_res')
thus ?thesis
using ‹0 < l› ‹s m = res_seq s (Suc n) l ∧ l ≤ m› less_le_trans ‹s m (Suc n) = a (Suc n)›
by (metis ‹a (Suc n) = res_seq s (Suc n) 0 (Suc n)› ‹is_subseq_of s (res_seq s (Suc n))›
assms(1) lessI is_subseq_ofE res_seq_res' )
qed
lemma increasing_conv_subseq_fun_0:
assumes "s ∈ closed_seqs Zp"
assumes "∃s'. s' = convergent_subseq s"
assumes "a = acc_point s"
shows "convergent_subseq_fun s a (Suc n) > convergent_subseq_fun s a n"
apply(auto)
proof(induction n)
case 0
have "convergent_subseq_fun s a 0 = 0" by simp
then show ?case
by (smt assms(1) assms(3) less_Suc_eq less_Suc_eq_0_disj increasing_conv_induction_0_pre padic_integers_axioms someI_ex)
next
case (Suc k)
then show ?case
by (metis (mono_tags, lifting) assms(1) assms(3) increasing_conv_induction_0_pre someI_ex)
qed
lemma increasing_conv_subseq_fun:
assumes "s ∈ closed_seqs Zp"
assumes "a = acc_point s"
assumes "∃s'. s' = convergent_subseq s"
shows "is_increasing (convergent_subseq_fun s a)"
by (metis assms(1) assms(2) increasing_conv_subseq_fun_0 is_increasingI lift_Suc_mono_less)
lemma convergent_subseq_is_subseq:
assumes "s ∈ closed_seqs Zp"
shows "is_subseq_of s (convergent_subseq s)"
using assms convergent_subseq_def increasing_conv_subseq_fun is_subseqI by blast
lemma is_closed_seq_conv_subseq:
assumes "s ∈ closed_seqs Zp"
shows "(convergent_subseq s) ∈ closed_seqs Zp"
by (simp add: assms convergent_subseq_def closed_seqs_memI closed_seqs_memE take_subseq_def)
lemma convergent_subseq_res:
assumes "s ∈ closed_seqs Zp"
assumes "a = acc_point s"
shows "convergent_subseq s l l = residue (p ^ l) (acc_point s l)"
proof-
have "∃k. convergent_subseq s l = s k ∧ s k l = a l"
proof-
have "convergent_subseq s l = s (convergent_subseq_fun s a l)"
by (simp add: assms(2) convergent_subseq_def take_subseq_def)
obtain k where kdef: "(convergent_subseq_fun s a l) = k"
by simp
have "convergent_subseq s l = s k"
by (simp add: ‹convergent_subseq s l = s (convergent_subseq_fun s a l)› kdef)
have "s k l = a l"
proof(cases "l = 0")
case True
then show ?thesis
using acc_point_def assms(1) assms(2)
by (metis closed_seqs_memE p_res_ring_0' residues_closed)
next
case False
have "0 < l"
using False by blast
then have "k > convergent_subseq_fun s a (l-1)"
by (metis One_nat_def Suc_pred assms(1) assms(2) increasing_conv_subseq_fun_0 kdef)
then have "s k l = a l" using kdef
assms(1) assms(2) convergent_subseq_fun.simps(2) increasing_conv_induction_0_pre
padic_integers_axioms someI_ex One_nat_def ‹0 < l› increasing_conv_induction_0_pre
by (smt Suc_pred)
then show ?thesis
by simp
qed
then have "convergent_subseq s l = s k ∧ s k l = a l"
using ‹convergent_subseq s l = s k› by blast
thus ?thesis
by blast
qed
thus ?thesis
using acc_point_closed assms(1) assms(2) Zp_defs(3) prime padic_set_res_coherent by force
qed
lemma convergent_subseq_res':
assumes "s ∈ closed_seqs Zp"
assumes "n > l"
shows "convergent_subseq s n l = convergent_subseq s l l "
proof-
have 0: "convergent_subseq s l l = residue (p ^ l) (acc_point s l)"
using assms(1) convergent_subseq_res by auto
have 1: "convergent_subseq s n n = residue (p ^ n) (acc_point s n)"
by (simp add: assms(1) convergent_subseq_res)
have 2: "convergent_subseq s n l = residue (p ^ l) (convergent_subseq s l l)"
using 0 assms 1 Zp_defs(3) acc_point_closed is_closed_seq_conv_subseq
closed_seqs_memE le_refl less_imp_le_nat prime
by (metis padic_set_res_coherent)
show ?thesis using 0 1 2 Zp_defs(3) assms(1) is_closed_seq_conv_subseq closed_seqs_memE le_refl prime
by (metis padic_set_res_coherent)
qed
lemma convergent_subsequence_is_convergent:
assumes "s ∈ closed_seqs Zp"
assumes "a = acc_point s"
shows "Zp_converges_to (convergent_subseq s) (acc_point s)"
proof(rule Zp_converges_toI)
show "acc_point s ∈ carrier Zp"
using acc_point_closed assms by blast
show "convergent_subseq s ∈ carrier (Zp⇗ω⇖)"
using is_closed_seq_conv_subseq assms by simp
show "⋀n. ∃N. ∀k>N. convergent_subseq s k n = acc_point s n"
proof-
fix n
show "∃N. ∀k>N. convergent_subseq s k n = acc_point s n"
proof(induction n)
case 0
then show ?case
using acc_point_closed[of s] assms convergent_subseq_def closed_seqs_memE of_nat_0
ord_pos take_subseq_def zero_below_ord is_closed_seq_conv_subseq[of s]
by (metis residue_of_zero(2))
next
case (Suc n)
have "acc_point s (Suc n) = res_seq s (Suc n) 0 (Suc n)"
by (simp add: acc_point_def)
obtain k where kdef: "convergent_subseq_fun s a (Suc n) = k" by simp
have "Suc n > 0" by simp
then have "k > (convergent_subseq_fun s a n)"
using assms(1) assms(2) increasing_conv_subseq_fun_0 kdef by blast
then have " k > (convergent_subseq_fun s a n) ∧ (s k (Suc n)) = a (Suc n)" using kdef
by (metis (mono_tags, lifting) assms(1) assms(2) convergent_subseq_fun.simps(2) increasing_conv_induction_0_pre someI_ex)
have "s k (Suc n) = a (Suc n)"
using ‹convergent_subseq_fun s a n < k ∧ s k (Suc n) = a (Suc n)› by blast
then have "convergent_subseq s (Suc n) (Suc n) = a (Suc n)"
by (metis assms(2) convergent_subseq_def kdef take_subseq_def)
then have "∀l > n. convergent_subseq s l (Suc n) = a (Suc n)"
using convergent_subseq_res'
by (metis Suc_lessI assms(1))
then show ?case
using assms(2) by blast
qed
qed
qed
theorem Zp_is_compact:
assumes "s ∈ closed_seqs Zp"
shows "∃s'. is_subseq_of s s' ∧ (Zp_converges_to s' (acc_point s))"
using assms convergent_subseq_is_subseq convergent_subsequence_is_convergent
by blast
end
end